tm: thys/Recursive.thy@d8e6f0798e23 (annotated)

163 67063c5365e1 changed theory names to uppercase Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 131 diff changeset	1	theory Recursive
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2	imports Abacus Rec_Def Abacus_Hoare
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	3	begin
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	4
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	5	fun addition :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> abc_prog"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	6	where
166 99a180fd4194 removed some dead code Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 163 diff changeset	7	"addition m n p = [Dec m 4, Inc n, Inc p, Goto 0, Dec p 7, Inc m, Goto 4]"
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	8
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	9	fun mv_box :: "nat \<Rightarrow> nat \<Rightarrow> abc_prog"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	10	where
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	11	"mv_box m n = [Dec m 3, Inc n, Goto 0]"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	12
166 99a180fd4194 removed some dead code Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 163 diff changeset	13	text {* The compilation of @{text "z"}-operator. *}
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	14	definition rec_ci_z :: "abc_inst list"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	15	where
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	16	"rec_ci_z \<equiv> [Goto 1]"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	17
166 99a180fd4194 removed some dead code Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 163 diff changeset	18	text {* The compilation of @{text "s"}-operator. *}
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	19	definition rec_ci_s :: "abc_inst list"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	20	where
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	21	"rec_ci_s \<equiv> (addition 0 1 2 [+] [Inc 1])"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	22
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	23
166 99a180fd4194 removed some dead code Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 163 diff changeset	24	text {* The compilation of @{text "id i j"}-operator *}
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	25	fun rec_ci_id :: "nat \<Rightarrow> nat \<Rightarrow> abc_inst list"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	26	where
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	27	"rec_ci_id i j = addition j i (i + 1)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	28
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	29	fun mv_boxes :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> abc_inst list"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	30	where
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	31	"mv_boxes ab bb 0 = []" \|
166 99a180fd4194 removed some dead code Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 163 diff changeset	32	"mv_boxes ab bb (Suc n) = mv_boxes ab bb n [+] mv_box (ab + n) (bb + n)"
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	33
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	34	fun empty_boxes :: "nat \<Rightarrow> abc_inst list"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	35	where
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	36	"empty_boxes 0 = []" \|
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	37	"empty_boxes (Suc n) = empty_boxes n [+] [Dec n 2, Goto 0]"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	38
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	39	fun cn_merge_gs ::
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	40	"(abc_inst list \<times> nat \<times> nat) list \<Rightarrow> nat \<Rightarrow> abc_inst list"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	41	where
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	42	"cn_merge_gs [] p = []" \|
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	43	"cn_merge_gs (g # gs) p =
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	44	(let (gprog, gpara, gn) = g in
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	45	gprog [+] mv_box gpara p [+] cn_merge_gs gs (Suc p))"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	46
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	47
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	48	text {*
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	49	The compiler of recursive functions, where @{text "rec_ci recf"} return
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	50	@{text "(ap, arity, fp)"}, where @{text "ap"} is the Abacus program, @{text "arity"} is the
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	51	arity of the recursive function @{text "recf"},
166 99a180fd4194 removed some dead code Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 163 diff changeset	52	@{text "fp"} is the amount of memory which is going to be
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	53	used by @{text "ap"} for its execution.
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	54	*}
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	55
203 514809bb7ce4 simplified slightly rec_compilation function Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 190 diff changeset	56	fun rec_ci :: "recf \<Rightarrow> abc_inst list \<times> nat \<times> nat"
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	57	where
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	58	"rec_ci z = (rec_ci_z, 1, 2)" \|
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	59	"rec_ci s = (rec_ci_s, 1, 3)" \|
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	60	"rec_ci (id m n) = (rec_ci_id m n, m, m + 2)" \|
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	61	"rec_ci (Cn n f gs) =
203 514809bb7ce4 simplified slightly rec_compilation function Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 190 diff changeset	62	(let cied_gs = map (\<lambda> g. rec_ci g) gs in
514809bb7ce4 simplified slightly rec_compilation function Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 190 diff changeset	63	let (fprog, fpara, fn) = rec_ci f in
514809bb7ce4 simplified slightly rec_compilation function Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 190 diff changeset	64	let pstr = Max (set (Suc n # fn # (map (\<lambda> (aprog, p, n). n) cied_gs))) in
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	65	let qstr = pstr + Suc (length gs) in
203 514809bb7ce4 simplified slightly rec_compilation function Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 190 diff changeset	66	(cn_merge_gs cied_gs pstr [+] mv_boxes 0 qstr n [+]
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	67	mv_boxes pstr 0 (length gs) [+] fprog [+]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	68	mv_box fpara pstr [+] empty_boxes (length gs) [+]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	69	mv_box pstr n [+] mv_boxes qstr 0 n, n, qstr + n))" \|
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	70	"rec_ci (Pr n f g) =
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	71	(let (fprog, fpara, fn) = rec_ci f in
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	72	let (gprog, gpara, gn) = rec_ci g in
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	73	let p = Max (set ([n + 3, fn, gn])) in
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	74	let e = length gprog + 7 in
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	75	(mv_box n p [+] fprog [+] mv_box n (Suc n) [+]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	76	(([Dec p e] [+] gprog [+]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	77	[Inc n, Dec (Suc n) 3, Goto 1]) @
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	78	[Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length gprog + 4)]),
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	79	Suc n, p + 1))" \|
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	80	"rec_ci (Mn n f) =
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	81	(let (fprog, fpara, fn) = rec_ci f in
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	82	let len = length (fprog) in
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	83	(fprog @ [Dec (Suc n) (len + 5), Dec (Suc n) (len + 3),
166 99a180fd4194 removed some dead code Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 163 diff changeset	84	Goto (len + 1), Inc n, Goto 0], n, max (Suc n) fn))"
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	85
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	86	declare rec_ci.simps [simp del] rec_ci_s_def[simp del]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	87	rec_ci_z_def[simp del] rec_ci_id.simps[simp del]
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	88	mv_boxes.simps[simp del]
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	89	mv_box.simps[simp del] addition.simps[simp del]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	90
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	91	declare abc_steps_l.simps[simp del] abc_fetch.simps[simp del]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	92	abc_step_l.simps[simp del]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	93
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	94	inductive_cases terminate_pr_reverse: "terminate (Pr n f g) xs"
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	95
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	96	inductive_cases terminate_z_reverse[elim!]: "terminate z xs"
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	97
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	98	inductive_cases terminate_s_reverse[elim!]: "terminate s xs"
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	99
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	100	inductive_cases terminate_id_reverse[elim!]: "terminate (id m n) xs"
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	101
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	102	inductive_cases terminate_cn_reverse[elim!]: "terminate (Cn n f gs) xs"
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	103
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	104	inductive_cases terminate_mn_reverse[elim!]:"terminate (Mn n f) xs"
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	105
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	106	fun addition_inv :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	107	nat list \<Rightarrow> bool"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	108	where
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	109	"addition_inv (as, lm') m n p lm =
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	110	(let sn = lm ! n in
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	111	let sm = lm ! m in
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	112	lm ! p = 0 \<and>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	113	(if as = 0 then \<exists> x. x \<le> lm ! m \<and> lm' = lm[m := x,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	114	n := (sn + sm - x), p := (sm - x)]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	115	else if as = 1 then \<exists> x. x < lm ! m \<and> lm' = lm[m := x,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	116	n := (sn + sm - x - 1), p := (sm - x - 1)]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	117	else if as = 2 then \<exists> x. x < lm ! m \<and> lm' = lm[m := x,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	118	n := (sn + sm - x), p := (sm - x - 1)]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	119	else if as = 3 then \<exists> x. x < lm ! m \<and> lm' = lm[m := x,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	120	n := (sn + sm - x), p := (sm - x)]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	121	else if as = 4 then \<exists> x. x \<le> lm ! m \<and> lm' = lm[m := x,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	122	n := (sn + sm), p := (sm - x)]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	123	else if as = 5 then \<exists> x. x < lm ! m \<and> lm' = lm[m := x,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	124	n := (sn + sm), p := (sm - x - 1)]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	125	else if as = 6 then \<exists> x. x < lm ! m \<and> lm' =
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	126	lm[m := Suc x, n := (sn + sm), p := (sm - x - 1)]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	127	else if as = 7 then lm' = lm[m := sm, n := (sn + sm)]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	128	else False))"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	129
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	130	fun addition_stage1 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	131	where
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	132	"addition_stage1 (as, lm) m p =
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	133	(if as = 0 \<or> as = 1 \<or> as = 2 \<or> as = 3 then 2
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	134	else if as = 4 \<or> as = 5 \<or> as = 6 then 1
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	135	else 0)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	136
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	137	fun addition_stage2 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	138	where
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	139	"addition_stage2 (as, lm) m p =
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	140	(if 0 \<le> as \<and> as \<le> 3 then lm ! m
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	141	else if 4 \<le> as \<and> as \<le> 6 then lm ! p
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	142	else 0)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	143
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	144	fun addition_stage3 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	145	where
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	146	"addition_stage3 (as, lm) m p =
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	147	(if as = 1 then 4
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	148	else if as = 2 then 3
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	149	else if as = 3 then 2
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	150	else if as = 0 then 1
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	151	else if as = 5 then 2
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	152	else if as = 6 then 1
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	153	else if as = 4 then 0
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	154	else 0)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	155
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	156	fun addition_measure :: "((nat \<times> nat list) \<times> nat \<times> nat) \<Rightarrow>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	157	(nat \<times> nat \<times> nat)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	158	where
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	159	"addition_measure ((as, lm), m, p) =
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	160	(addition_stage1 (as, lm) m p,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	161	addition_stage2 (as, lm) m p,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	162	addition_stage3 (as, lm) m p)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	163
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	164	definition addition_LE :: "(((nat \<times> nat list) \<times> nat \<times> nat) \<times>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	165	((nat \<times> nat list) \<times> nat \<times> nat)) set"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	166	where "addition_LE \<equiv> (inv_image lex_triple addition_measure)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	167
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	168	lemma [simp]: "wf addition_LE"
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	169	by(auto simp: wf_inv_image addition_LE_def lex_triple_def
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	170	lex_pair_def)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	171
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	172	declare addition_inv.simps[simp del]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	173
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	174	lemma addition_inv_init:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	175	"\<lbrakk>m \<noteq> n; max m n < p; length lm > p; lm ! p = 0\<rbrakk> \<Longrightarrow>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	176	addition_inv (0, lm) m n p lm"
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	177	apply(simp add: addition_inv.simps Let_def)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	178	apply(rule_tac x = "lm ! m" in exI, simp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	179	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	180
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	181	lemma [simp]: "abc_fetch 0 (addition m n p) = Some (Dec m 4)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	182	by(simp add: abc_fetch.simps addition.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	183
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	184	lemma [simp]: "abc_fetch (Suc 0) (addition m n p) = Some (Inc n)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	185	by(simp add: abc_fetch.simps addition.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	186
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	187	lemma [simp]: "abc_fetch 2 (addition m n p) = Some (Inc p)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	188	by(simp add: abc_fetch.simps addition.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	189
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	190	lemma [simp]: "abc_fetch 3 (addition m n p) = Some (Goto 0)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	191	by(simp add: abc_fetch.simps addition.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	192
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	193	lemma [simp]: "abc_fetch 4 (addition m n p) = Some (Dec p 7)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	194	by(simp add: abc_fetch.simps addition.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	195
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	196	lemma [simp]: "abc_fetch 5 (addition m n p) = Some (Inc m)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	197	by(simp add: abc_fetch.simps addition.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	198
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	199	lemma [simp]: "abc_fetch 6 (addition m n p) = Some (Goto 4)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	200	by(simp add: abc_fetch.simps addition.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	201
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	202	lemma [simp]:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	203	"\<lbrakk>m \<noteq> n; p < length lm; lm ! p = 0; m < p; n < p; x \<le> lm ! m; 0 < x\<rbrakk>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	204	\<Longrightarrow> \<exists>xa<lm ! m. lm[m := x, n := lm ! n + lm ! m - x,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	205	p := lm ! m - x, m := x - Suc 0] =
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	206	lm[m := xa, n := lm ! n + lm ! m - Suc xa,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	207	p := lm ! m - Suc xa]"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	208	apply(case_tac x, simp, simp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	209	apply(rule_tac x = nat in exI, simp add: list_update_swap
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	210	list_update_overwrite)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	211	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	212
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	213	lemma [simp]:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	214	"\<lbrakk>m \<noteq> n; p < length lm; lm ! p = 0; m < p; n < p; x < lm ! m\<rbrakk>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	215	\<Longrightarrow> \<exists>xa<lm ! m. lm[m := x, n := lm ! n + lm ! m - Suc x,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	216	p := lm ! m - Suc x, n := lm ! n + lm ! m - x]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	217	= lm[m := xa, n := lm ! n + lm ! m - xa,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	218	p := lm ! m - Suc xa]"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	219	apply(rule_tac x = x in exI,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	220	simp add: list_update_swap list_update_overwrite)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	221	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	222
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	223	lemma [simp]:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	224	"\<lbrakk>m \<noteq> n; p < length lm; lm ! p = 0; m < p; n < p; x < lm ! m\<rbrakk>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	225	\<Longrightarrow> \<exists>xa<lm ! m. lm[m := x, n := lm ! n + lm ! m - x,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	226	p := lm ! m - Suc x, p := lm ! m - x]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	227	= lm[m := xa, n := lm ! n + lm ! m - xa,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	228	p := lm ! m - xa]"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	229	apply(rule_tac x = x in exI, simp add: list_update_overwrite)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	230	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	231
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	232	lemma [simp]:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	233	"\<lbrakk>m \<noteq> n; p < length lm; lm ! p = (0::nat); m < p; n < p; x < lm ! m\<rbrakk>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	234	\<Longrightarrow> \<exists>xa\<le>lm ! m. lm[m := x, n := lm ! n + lm ! m - x,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	235	p := lm ! m - x] =
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	236	lm[m := xa, n := lm ! n + lm ! m - xa,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	237	p := lm ! m - xa]"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	238	apply(rule_tac x = x in exI, simp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	239	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	240
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	241	lemma [simp]:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	242	"\<lbrakk>m \<noteq> n; p < length lm; lm ! p = 0; m < p; n < p;
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	243	x \<le> lm ! m; lm ! m \<noteq> x\<rbrakk>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	244	\<Longrightarrow> \<exists>xa<lm ! m. lm[m := x, n := lm ! n + lm ! m,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	245	p := lm ! m - x, p := lm ! m - Suc x]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	246	= lm[m := xa, n := lm ! n + lm ! m,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	247	p := lm ! m - Suc xa]"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	248	apply(rule_tac x = x in exI, simp add: list_update_overwrite)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	249	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	250
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	251	lemma [simp]:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	252	"\<lbrakk>m \<noteq> n; p < length lm; lm ! p = 0; m < p; n < p; x < lm ! m\<rbrakk>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	253	\<Longrightarrow> \<exists>xa<lm ! m. lm[m := x, n := lm ! n + lm ! m,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	254	p := lm ! m - Suc x, m := Suc x]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	255	= lm[m := Suc xa, n := lm ! n + lm ! m,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	256	p := lm ! m - Suc xa]"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	257	apply(rule_tac x = x in exI,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	258	simp add: list_update_swap list_update_overwrite)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	259	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	260
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	261	lemma [simp]:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	262	"\<lbrakk>m \<noteq> n; p < length lm; lm ! p = 0; m < p; n < p; x < lm ! m\<rbrakk>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	263	\<Longrightarrow> \<exists>xa\<le>lm ! m. lm[m := Suc x, n := lm ! n + lm ! m,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	264	p := lm ! m - Suc x]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	265	= lm[m := xa, n := lm ! n + lm ! m, p := lm ! m - xa]"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	266	apply(rule_tac x = "Suc x" in exI, simp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	267	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	268
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	269	lemma abc_steps_zero: "abc_steps_l asm ap 0 = asm"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	270	apply(case_tac asm, simp add: abc_steps_l.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	271	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	272
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	273	declare Let_def[simp]
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	274	lemma addition_halt_lemma:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	275	"\<lbrakk>m \<noteq> n; max m n < p; length lm > p; lm ! p = 0\<rbrakk> \<Longrightarrow>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	276	\<forall>na. \<not> (\<lambda>(as, lm') (m, p). as = 7)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	277	(abc_steps_l (0, lm) (addition m n p) na) (m, p) \<and>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	278	addition_inv (abc_steps_l (0, lm) (addition m n p) na) m n p lm
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	279	\<longrightarrow> addition_inv (abc_steps_l (0, lm) (addition m n p)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	280	(Suc na)) m n p lm
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	281	\<and> ((abc_steps_l (0, lm) (addition m n p) (Suc na), m, p),
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	282	abc_steps_l (0, lm) (addition m n p) na, m, p) \<in> addition_LE"
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	283	apply(rule allI, rule impI, simp add: abc_step_red2)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	284	apply(case_tac "(abc_steps_l (0, lm) (addition m n p) na)", simp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	285	apply(auto split:if_splits simp add: addition_inv.simps
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	286	abc_steps_zero)
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	287	apply(simp_all add: addition.simps abc_steps_l.simps)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	288	apply(auto simp add: addition_LE_def lex_triple_def lex_pair_def
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	289	abc_step_l.simps addition_inv.simps
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	290	abc_lm_v.simps abc_lm_s.simps nth_append
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	291	split: if_splits)
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	292	apply(rule_tac [!] x = x in exI, simp_all add: list_update_overwrite Suc_diff_Suc)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	293	by (metis list_update_overwrite list_update_swap nat_neq_iff)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	294
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	295	lemma addition_correct':
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	296	"\<lbrakk>m \<noteq> n; max m n < p; length lm > p; lm ! p = 0\<rbrakk> \<Longrightarrow>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	297	\<exists> stp. (\<lambda> (as, lm'). as = 7 \<and> addition_inv (as, lm') m n p lm)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	298	(abc_steps_l (0, lm) (addition m n p) stp)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	299	apply(insert halt_lemma2[of addition_LE
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	300	"\<lambda> ((as, lm'), m, p). addition_inv (as, lm') m n p lm"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	301	"\<lambda> stp. (abc_steps_l (0, lm) (addition m n p) stp, m, p)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	302	"\<lambda> ((as, lm'), m, p). as = 7"],
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	303	simp add: abc_steps_zero addition_inv_init)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	304	apply(drule_tac addition_halt_lemma, simp, simp, simp,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	305	simp, erule_tac exE)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	306	apply(rule_tac x = na in exI,
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	307	case_tac "(abc_steps_l (0, lm) (addition m n p) na)", auto)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	308	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	309
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	310	lemma length_addition[simp]: "length (addition a b c) = 7"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	311	by(auto simp: addition.simps)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	312
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	313	lemma addition_correct:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	314	"\<lbrakk>m \<noteq> n; max m n < p; length lm > p; lm ! p = 0\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	315	\<Longrightarrow> {\<lambda> a. a = lm} (addition m n p) {\<lambda> nl. addition_inv (7, nl) m n p lm}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	316	using assms
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	317	proof(rule_tac abc_Hoare_haltI, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	318	fix lma
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	319	assume "m \<noteq> n" "m < p \<and> n < p" "p < length lm" "lm ! p = 0"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	320	then have "\<exists> stp. (\<lambda> (as, lm'). as = 7 \<and> addition_inv (as, lm') m n p lm)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	321	(abc_steps_l (0, lm) (addition m n p) stp)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	322	by(rule_tac addition_correct', auto simp: addition_inv.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	323	thus "\<exists>na. abc_final (abc_steps_l (0, lm) (addition m n p) na) (addition m n p) \<and>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	324	(\<lambda>nl. addition_inv (7, nl) m n p lm) abc_holds_for abc_steps_l (0, lm) (addition m n p) na"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	325	apply(erule_tac exE)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	326	apply(rule_tac x = stp in exI)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	327	apply(auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	328	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	329	qed
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	330
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	331	lemma compile_s_correct':
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	332	"{\<lambda>nl. nl = n # 0 \<up> 2 @ anything} addition 0 (Suc 0) 2 [+] [Inc (Suc 0)] {\<lambda>nl. nl = n # Suc n # 0 # anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	333	proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	334	show "{\<lambda>nl. nl = n # 0 \<up> 2 @ anything} addition 0 (Suc 0) 2 {\<lambda> nl. addition_inv (7, nl) 0 (Suc 0) 2 (n # 0 \<up> 2 @ anything)}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	335	by(rule_tac addition_correct, auto simp: numeral_2_eq_2)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	336	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	337	show "{\<lambda>nl. addition_inv (7, nl) 0 (Suc 0) 2 (n # 0 \<up> 2 @ anything)} [Inc (Suc 0)] {\<lambda>nl. nl = n # Suc n # 0 # anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	338	by(rule_tac abc_Hoare_haltI, rule_tac x = 1 in exI, auto simp: addition_inv.simps
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	339	abc_steps_l.simps abc_step_l.simps abc_fetch.simps numeral_2_eq_2 abc_lm_s.simps abc_lm_v.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	340	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	341
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	342	declare rec_exec.simps[simp del]
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	343
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	344	lemma abc_comp_commute: "(A [+] B) [+] C = A [+] (B [+] C)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	345	apply(auto simp: abc_comp.simps abc_shift.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	346	apply(case_tac x, auto)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	347	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	348
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	349
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	350
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	351	lemma compile_z_correct:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	352	"\<lbrakk>rec_ci z = (ap, arity, fp); rec_exec z [n] = r\<rbrakk> \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	353	{\<lambda>nl. nl = n # 0 \<up> (fp - arity) @ anything} ap {\<lambda>nl. nl = n # r # 0 \<up> (fp - Suc arity) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	354	apply(rule_tac abc_Hoare_haltI)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	355	apply(rule_tac x = 1 in exI)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	356	apply(auto simp: abc_steps_l.simps rec_ci.simps rec_ci_z_def
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	357	numeral_2_eq_2 abc_fetch.simps abc_step_l.simps rec_exec.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	358	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	359
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	360	lemma compile_s_correct:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	361	"\<lbrakk>rec_ci s = (ap, arity, fp); rec_exec s [n] = r\<rbrakk> \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	362	{\<lambda>nl. nl = n # 0 \<up> (fp - arity) @ anything} ap {\<lambda>nl. nl = n # r # 0 \<up> (fp - Suc arity) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	363	apply(auto simp: rec_ci.simps rec_ci_s_def compile_s_correct' rec_exec.simps)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	364	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	365
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	366	lemma compile_id_correct':
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	367	assumes "n < length args"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	368	shows "{\<lambda>nl. nl = args @ 0 \<up> 2 @ anything} addition n (length args) (Suc (length args))
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	369	{\<lambda>nl. nl = args @ rec_exec (recf.id (length args) n) args # 0 # anything}"
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	370	proof -
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	371	have "{\<lambda>nl. nl = args @ 0 \<up> 2 @ anything} addition n (length args) (Suc (length args))
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	372	{\<lambda>nl. addition_inv (7, nl) n (length args) (Suc (length args)) (args @ 0 \<up> 2 @ anything)}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	373	using assms
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	374	by(rule_tac addition_correct, auto simp: numeral_2_eq_2 nth_append)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	375	thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	376	using assms
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	377	by(simp add: addition_inv.simps rec_exec.simps
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	378	nth_append numeral_2_eq_2 list_update_append)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	379	qed
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	380
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	381	lemma compile_id_correct:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	382	"\<lbrakk>n < m; length xs = m; rec_ci (recf.id m n) = (ap, arity, fp); rec_exec (recf.id m n) xs = r\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	383	\<Longrightarrow> {\<lambda>nl. nl = xs @ 0 \<up> (fp - arity) @ anything} ap {\<lambda>nl. nl = xs @ r # 0 \<up> (fp - Suc arity) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	384	apply(auto simp: rec_ci.simps rec_ci_id.simps compile_id_correct')
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	385	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	386
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	387	lemma cn_merge_gs_tl_app:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	388	"cn_merge_gs (gs @ [g]) pstr =
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	389	cn_merge_gs gs pstr [+] cn_merge_gs [g] (pstr + length gs)"
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	390	apply(induct gs arbitrary: pstr, simp add: cn_merge_gs.simps, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	391	apply(simp add: abc_comp_commute)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	392	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	393
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	394	lemma footprint_ge:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	395	"rec_ci a = (p, arity, fp) \<Longrightarrow> arity < fp"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	396	apply(induct a)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	397	apply(auto simp: rec_ci.simps)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	398	apply(case_tac "rec_ci a", simp)
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	399	apply(case_tac "rec_ci a1", case_tac "rec_ci a2", auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	400	apply(case_tac "rec_ci a", auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	401	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	402
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	403	lemma param_pattern:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	404	"\<lbrakk>terminate f xs; rec_ci f = (p, arity, fp)\<rbrakk> \<Longrightarrow> length xs = arity"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	405	apply(induct arbitrary: p arity fp rule: terminate.induct)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	406	apply(auto simp: rec_ci.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	407	apply(case_tac "rec_ci f", simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	408	apply(case_tac "rec_ci f", case_tac "rec_ci g", simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	409	apply(case_tac "rec_ci f", case_tac "rec_ci gs", simp)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	410	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	411
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	412	lemma replicate_merge_anywhere:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	413	"x\<up>a @ x\<up>b @ ys = x\<up>(a+b) @ ys"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	414	by(simp add:replicate_add)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	415
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	416	fun mv_box_inv :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat list \<Rightarrow> bool"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	417	where
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	418	"mv_box_inv (as, lm) m n initlm =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	419	(let plus = initlm ! m + initlm ! n in
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	420	length initlm > max m n \<and> m \<noteq> n \<and>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	421	(if as = 0 then \<exists> k l. lm = initlm[m := k, n := l] \<and>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	422	k + l = plus \<and> k \<le> initlm ! m
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	423	else if as = 1 then \<exists> k l. lm = initlm[m := k, n := l]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	424	\<and> k + l + 1 = plus \<and> k < initlm ! m
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	425	else if as = 2 then \<exists> k l. lm = initlm[m := k, n := l]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	426	\<and> k + l = plus \<and> k \<le> initlm ! m
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	427	else if as = 3 then lm = initlm[m := 0, n := plus]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	428	else False))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	429
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	430	fun mv_box_stage1 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	431	where
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	432	"mv_box_stage1 (as, lm) m =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	433	(if as = 3 then 0
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	434	else 1)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	435
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	436	fun mv_box_stage2 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	437	where
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	438	"mv_box_stage2 (as, lm) m = (lm ! m)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	439
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	440	fun mv_box_stage3 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	441	where
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	442	"mv_box_stage3 (as, lm) m = (if as = 1 then 3
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	443	else if as = 2 then 2
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	444	else if as = 0 then 1
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	445	else 0)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	446
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	447	fun mv_box_measure :: "((nat \<times> nat list) \<times> nat) \<Rightarrow> (nat \<times> nat \<times> nat)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	448	where
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	449	"mv_box_measure ((as, lm), m) =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	450	(mv_box_stage1 (as, lm) m, mv_box_stage2 (as, lm) m,
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	451	mv_box_stage3 (as, lm) m)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	452
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	453	definition lex_pair :: "((nat \<times> nat) \<times> nat \<times> nat) set"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	454	where
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	455	"lex_pair = less_than <lex> less_than"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	456
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	457	definition lex_triple ::
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	458	"((nat \<times> (nat \<times> nat)) \<times> (nat \<times> (nat \<times> nat))) set"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	459	where
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	460	"lex_triple \<equiv> less_than <lex> lex_pair"
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	461
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	462	definition mv_box_LE ::
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	463	"(((nat \<times> nat list) \<times> nat) \<times> ((nat \<times> nat list) \<times> nat)) set"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	464	where
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	465	"mv_box_LE \<equiv> (inv_image lex_triple mv_box_measure)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	466
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	467	lemma wf_lex_triple: "wf lex_triple"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	468	by (auto intro:wf_lex_prod simp:lex_triple_def lex_pair_def)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	469
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	470	lemma wf_mv_box_le[intro]: "wf mv_box_LE"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	471	by(auto intro:wf_inv_image wf_lex_triple simp: mv_box_LE_def)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	472
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	473	declare mv_box_inv.simps[simp del]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	474
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	475	lemma mv_box_inv_init:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	476	"\<lbrakk>m < length initlm; n < length initlm; m \<noteq> n\<rbrakk> \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	477	mv_box_inv (0, initlm) m n initlm"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	478	apply(simp add: abc_steps_l.simps mv_box_inv.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	479	apply(rule_tac x = "initlm ! m" in exI,
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	480	rule_tac x = "initlm ! n" in exI, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	481	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	482
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	483	lemma [simp]: "abc_fetch 0 (mv_box m n) = Some (Dec m 3)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	484	apply(simp add: mv_box.simps abc_fetch.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	485	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	486
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	487	lemma [simp]: "abc_fetch (Suc 0) (mv_box m n) =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	488	Some (Inc n)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	489	apply(simp add: mv_box.simps abc_fetch.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	490	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	491
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	492	lemma [simp]: "abc_fetch 2 (mv_box m n) = Some (Goto 0)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	493	apply(simp add: mv_box.simps abc_fetch.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	494	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	495
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	496	lemma [simp]: "abc_fetch 3 (mv_box m n) = None"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	497	apply(simp add: mv_box.simps abc_fetch.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	498	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	499
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	500	lemma replicate_Suc_iff_anywhere: "x # x\<up>b @ ys = x\<up>(Suc b) @ ys"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	501	by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	502
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	503	lemma [simp]:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	504	"\<lbrakk>m \<noteq> n; m < length initlm; n < length initlm;
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	505	k + l = initlm ! m + initlm ! n; k \<le> initlm ! m; 0 < k\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	506	\<Longrightarrow> \<exists>ka la. initlm[m := k, n := l, m := k - Suc 0] =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	507	initlm[m := ka, n := la] \<and>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	508	Suc (ka + la) = initlm ! m + initlm ! n \<and>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	509	ka < initlm ! m"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	510	apply(rule_tac x = "k - Suc 0" in exI, rule_tac x = l in exI,
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	511	simp, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	512	apply(subgoal_tac
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	513	"initlm[m := k, n := l, m := k - Suc 0] =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	514	initlm[n := l, m := k, m := k - Suc 0]")
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	515	apply(simp add: list_update_overwrite )
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	516	apply(simp add: list_update_swap)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	517	apply(simp add: list_update_swap)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	518	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	519
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	520	lemma [simp]:
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	521	"\<lbrakk>m \<noteq> n; m < length initlm; n < length initlm;
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	522	Suc (k + l) = initlm ! m + initlm ! n;
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	523	k < initlm ! m\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	524	\<Longrightarrow> \<exists>ka la. initlm[m := k, n := l, n := Suc l] =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	525	initlm[m := ka, n := la] \<and>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	526	ka + la = initlm ! m + initlm ! n \<and>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	527	ka \<le> initlm ! m"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	528	apply(rule_tac x = k in exI, rule_tac x = "Suc l" in exI, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	529	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	530
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	531	lemma [simp]:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	532	"\<lbrakk>length initlm > max m n; m \<noteq> n\<rbrakk> \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	533	\<forall>na. \<not> (\<lambda>(as, lm) m. as = 3)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	534	(abc_steps_l (0, initlm) (mv_box m n) na) m \<and>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	535	mv_box_inv (abc_steps_l (0, initlm)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	536	(mv_box m n) na) m n initlm \<longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	537	mv_box_inv (abc_steps_l (0, initlm)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	538	(mv_box m n) (Suc na)) m n initlm \<and>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	539	((abc_steps_l (0, initlm) (mv_box m n) (Suc na), m),
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	540	abc_steps_l (0, initlm) (mv_box m n) na, m) \<in> mv_box_LE"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	541	apply(rule allI, rule impI, simp add: abc_step_red2)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	542	apply(case_tac "(abc_steps_l (0, initlm) (mv_box m n) na)",
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	543	simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	544	apply(auto split:if_splits simp add:abc_steps_l.simps mv_box_inv.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	545	apply(auto simp add: mv_box_LE_def lex_triple_def lex_pair_def
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	546	abc_step_l.simps abc_steps_l.simps
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	547	mv_box_inv.simps abc_lm_v.simps abc_lm_s.simps
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	548	split: if_splits )
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	549	apply(rule_tac x = k in exI, rule_tac x = "Suc l" in exI, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	550	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	551
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	552	lemma mv_box_inv_halt:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	553	"\<lbrakk>length initlm > max m n; m \<noteq> n\<rbrakk> \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	554	\<exists> stp. (\<lambda> (as, lm). as = 3 \<and>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	555	mv_box_inv (as, lm) m n initlm)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	556	(abc_steps_l (0::nat, initlm) (mv_box m n) stp)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	557	apply(insert halt_lemma2[of mv_box_LE
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	558	"\<lambda> ((as, lm), m). mv_box_inv (as, lm) m n initlm"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	559	"\<lambda> stp. (abc_steps_l (0, initlm) (mv_box m n) stp, m)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	560	"\<lambda> ((as, lm), m). as = (3::nat)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	561	])
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	562	apply(insert wf_mv_box_le)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	563	apply(simp add: mv_box_inv_init abc_steps_zero)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	564	apply(erule_tac exE)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	565	apply(rule_tac x = na in exI)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	566	apply(case_tac "(abc_steps_l (0, initlm) (mv_box m n) na)",
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	567	simp, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	568	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	569
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	570	lemma mv_box_halt_cond:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	571	"\<lbrakk>m \<noteq> n; mv_box_inv (a, b) m n lm; a = 3\<rbrakk> \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	572	b = lm[n := lm ! m + lm ! n, m := 0]"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	573	apply(simp add: mv_box_inv.simps, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	574	apply(simp add: list_update_swap)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	575	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	576
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	577	lemma mv_box_correct':
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	578	"\<lbrakk>length lm > max m n; m \<noteq> n\<rbrakk> \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	579	\<exists> stp. abc_steps_l (0::nat, lm) (mv_box m n) stp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	580	= (3, (lm[n := (lm ! m + lm ! n)])[m := 0::nat])"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	581	apply(drule mv_box_inv_halt, simp, erule_tac exE)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	582	apply(rule_tac x = stp in exI)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	583	apply(case_tac "abc_steps_l (0, lm) (mv_box m n) stp",
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	584	simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	585	apply(erule_tac mv_box_halt_cond, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	586	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	587
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	588	lemma length_mvbox[simp]: "length (mv_box m n) = 3"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	589	by(simp add: mv_box.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	590
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	591	lemma mv_box_correct:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	592	"\<lbrakk>length lm > max m n; m\<noteq>n\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	593	\<Longrightarrow> {\<lambda> nl. nl = lm} mv_box m n {\<lambda> nl. nl = lm[n := (lm ! m + lm ! n), m:=0]}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	594	apply(drule_tac mv_box_correct', simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	595	apply(auto simp: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	596	apply(rule_tac x = stp in exI, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	597	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	598
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	599	declare list_update.simps(2)[simp del]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	600
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	601	lemma [simp]:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	602	"\<lbrakk>length xs < gf; gf \<le> ft; n < length gs\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	603	\<Longrightarrow> (rec_exec (gs ! n) xs # 0 \<up> (ft - Suc (length xs)) @ map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 # 0 \<up> length xs @ anything)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	604	[ft + n - length xs := rec_exec (gs ! n) xs, 0 := 0] =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	605	0 \<up> (ft - length xs) @ map (\<lambda>i. rec_exec i xs) (take n gs) @ rec_exec (gs ! n) xs # 0 \<up> (length gs - Suc n) @ 0 # 0 \<up> length xs @ anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	606	using list_update_append[of "rec_exec (gs ! n) xs # 0 \<up> (ft - Suc (length xs)) @ map (\<lambda>i. rec_exec i xs) (take n gs)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	607	"0 \<up> (length gs - n) @ 0 # 0 \<up> length xs @ anything" "ft + n - length xs" "rec_exec (gs ! n) xs"]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	608	apply(auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	609	apply(case_tac "length gs - n", simp, simp add: list_update.simps replicate_Suc_iff_anywhere Suc_diff_Suc del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	610	apply(simp add: list_update.simps)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	611	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	612
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	613	lemma compile_cn_gs_correct':
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	614	assumes
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	615	g_cond: "\<forall>g\<in>set (take n gs). terminate g xs \<and>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	616	(\<forall>x xa xb. rec_ci g = (x, xa, xb) \<longrightarrow> (\<forall>xc. {\<lambda>nl. nl = xs @ 0 \<up> (xb - xa) @ xc} x {\<lambda>nl. nl = xs @ rec_exec g xs # 0 \<up> (xb - Suc xa) @ xc}))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	617	and ft: "ft = max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	618	shows
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	619	"{\<lambda>nl. nl = xs @ 0 # 0 \<up> (ft + length gs) @ anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	620	cn_merge_gs (map rec_ci (take n gs)) ft
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	621	{\<lambda>nl. nl = xs @ 0 \<up> (ft - length xs) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	622	map (\<lambda>i. rec_exec i xs) (take n gs) @ 0\<up>(length gs - n) @ 0 \<up> Suc (length xs) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	623	using g_cond
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	624	proof(induct n)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	625	case 0
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	626	have "ft > length xs"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	627	using ft
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	628	by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	629	thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	630	apply(rule_tac abc_Hoare_haltI)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	631	apply(rule_tac x = 0 in exI, simp add: abc_steps_l.simps replicate_add[THEN sym]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	632	replicate_Suc[THEN sym] del: replicate_Suc)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	633	done
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	634	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	635	case (Suc n)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	636	have ind': "\<forall>g\<in>set (take n gs).
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	637	terminate g xs \<and> (\<forall>x xa xb. rec_ci g = (x, xa, xb) \<longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	638	(\<forall>xc. {\<lambda>nl. nl = xs @ 0 \<up> (xb - xa) @ xc} x {\<lambda>nl. nl = xs @ rec_exec g xs # 0 \<up> (xb - Suc xa) @ xc})) \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	639	{\<lambda>nl. nl = xs @ 0 # 0 \<up> (ft + length gs) @ anything} cn_merge_gs (map rec_ci (take n gs)) ft
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	640	{\<lambda>nl. nl = xs @ 0 \<up> (ft - length xs) @ map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 \<up> Suc (length xs) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	641	by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	642	have g_newcond: "\<forall>g\<in>set (take (Suc n) gs).
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	643	terminate g xs \<and> (\<forall>x xa xb. rec_ci g = (x, xa, xb) \<longrightarrow> (\<forall>xc. {\<lambda>nl. nl = xs @ 0 \<up> (xb - xa) @ xc} x {\<lambda>nl. nl = xs @ rec_exec g xs # 0 \<up> (xb - Suc xa) @ xc}))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	644	by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	645	from g_newcond have ind:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	646	"{\<lambda>nl. nl = xs @ 0 # 0 \<up> (ft + length gs) @ anything} cn_merge_gs (map rec_ci (take n gs)) ft
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	647	{\<lambda>nl. nl = xs @ 0 \<up> (ft - length xs) @ map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 \<up> Suc (length xs) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	648	apply(rule_tac ind', rule_tac ballI, erule_tac x = g in ballE, simp_all add: take_Suc)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	649	by(case_tac "n < length gs", simp add:take_Suc_conv_app_nth, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	650	show "?case"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	651	proof(cases "n < length gs")
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	652	case True
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	653	have h: "n < length gs" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	654	thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	655	proof(simp add: take_Suc_conv_app_nth cn_merge_gs_tl_app)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	656	obtain gp ga gf where a: "rec_ci (gs!n) = (gp, ga, gf)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	657	by (metis prod_cases3)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	658	moreover have "min (length gs) n = n"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	659	using h by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	660	moreover have
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	661	"{\<lambda>nl. nl = xs @ 0 # 0 \<up> (ft + length gs) @ anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	662	cn_merge_gs (map rec_ci (take n gs)) ft [+] (gp [+] mv_box ga (ft + n))
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	663	{\<lambda>nl. nl = xs @ 0 \<up> (ft - length xs) @ map (\<lambda>i. rec_exec i xs) (take n gs) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	664	rec_exec (gs ! n) xs # 0 \<up> (length gs - Suc n) @ 0 # 0 \<up> length xs @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	665	proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	666	show "{\<lambda>nl. nl = xs @ 0 # 0 \<up> (ft + length gs) @ anything} cn_merge_gs (map rec_ci (take n gs)) ft
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	667	{\<lambda>nl. nl = xs @ 0 \<up> (ft - length xs) @ map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 \<up> Suc (length xs) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	668	using ind by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	669	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	670	have x: "gs!n \<in> set (take (Suc n) gs)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	671	using h
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	672	by(simp add: take_Suc_conv_app_nth)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	673	have b: "terminate (gs!n) xs"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	674	using a g_newcond h x
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	675	by(erule_tac x = "gs!n" in ballE, simp_all)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	676	hence c: "length xs = ga"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	677	using a param_pattern by metis
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	678	have d: "gf > ga" using footprint_ge a by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	679	have e: "ft \<ge> gf" using ft a h
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	680	by(simp, rule_tac min_max.le_supI2, rule_tac Max_ge, simp,
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	681	rule_tac insertI2,
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	682	rule_tac f = "(\<lambda>(aprog, p, n). n)" and x = "rec_ci (gs!n)" in image_eqI, simp,
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	683	rule_tac x = "gs!n" in image_eqI, simp, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	684	show "{\<lambda>nl. nl = xs @ 0 \<up> (ft - length xs) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	685	map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 \<up> Suc (length xs) @ anything} gp [+] mv_box ga (ft + n)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	686	{\<lambda>nl. nl = xs @ 0 \<up> (ft - length xs) @ map (\<lambda>i. rec_exec i xs)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	687	(take n gs) @ rec_exec (gs ! n) xs # 0 \<up> (length gs - Suc n) @ 0 # 0 \<up> length xs @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	688	proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	689	show "{\<lambda>nl. nl = xs @ 0 \<up> (ft - length xs) @ map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 \<up> Suc (length xs) @ anything} gp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	690	{\<lambda>nl. nl = xs @ (rec_exec (gs!n) xs) # 0 \<up> (ft - Suc (length xs)) @ map (\<lambda>i. rec_exec i xs)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	691	(take n gs) @ 0 \<up> (length gs - n) @ 0 # 0 \<up> length xs @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	692	proof -
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	693	have
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	694	"({\<lambda>nl. nl = xs @ 0 \<up> (gf - ga) @ 0\<up>(ft - gf)@map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 \<up> Suc (length xs) @ anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	695	gp {\<lambda>nl. nl = xs @ (rec_exec (gs!n) xs) # 0 \<up> (gf - Suc ga) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	696	0\<up>(ft - gf)@map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 \<up> Suc (length xs) @ anything})"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	697	using a g_newcond h x
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	698	apply(erule_tac x = "gs!n" in ballE)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	699	apply(simp, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	700	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	701	thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	702	using a b c d e
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	703	by(simp add: replicate_merge_anywhere)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	704	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	705	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	706	show
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	707	"{\<lambda>nl. nl = xs @ rec_exec (gs ! n) xs #
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	708	0 \<up> (ft - Suc (length xs)) @ map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 # 0 \<up> length xs @ anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	709	mv_box ga (ft + n)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	710	{\<lambda>nl. nl = xs @ 0 \<up> (ft - length xs) @ map (\<lambda>i. rec_exec i xs) (take n gs) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	711	rec_exec (gs ! n) xs # 0 \<up> (length gs - Suc n) @ 0 # 0 \<up> length xs @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	712	proof -
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	713	have "{\<lambda>nl. nl = xs @ rec_exec (gs ! n) xs # 0 \<up> (ft - Suc (length xs)) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	714	map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 # 0 \<up> length xs @ anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	715	mv_box ga (ft + n) {\<lambda>nl. nl = (xs @ rec_exec (gs ! n) xs # 0 \<up> (ft - Suc (length xs)) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	716	map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 # 0 \<up> length xs @ anything)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	717	[ft + n := (xs @ rec_exec (gs ! n) xs # 0 \<up> (ft - Suc (length xs)) @ map (\<lambda>i. rec_exec i xs) (take n gs) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	718	0 \<up> (length gs - n) @ 0 # 0 \<up> length xs @ anything) ! ga +
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	719	(xs @ rec_exec (gs ! n) xs # 0 \<up> (ft - Suc (length xs)) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	720	map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 # 0 \<up> length xs @ anything) !
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	721	(ft + n), ga := 0]}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	722	using a c d e h
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	723	apply(rule_tac mv_box_correct)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	724	apply(simp, arith, arith)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	725	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	726	moreover have "(xs @ rec_exec (gs ! n) xs # 0 \<up> (ft - Suc (length xs)) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	727	map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 # 0 \<up> length xs @ anything)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	728	[ft + n := (xs @ rec_exec (gs ! n) xs # 0 \<up> (ft - Suc (length xs)) @ map (\<lambda>i. rec_exec i xs) (take n gs) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	729	0 \<up> (length gs - n) @ 0 # 0 \<up> length xs @ anything) ! ga +
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	730	(xs @ rec_exec (gs ! n) xs # 0 \<up> (ft - Suc (length xs)) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	731	map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 # 0 \<up> length xs @ anything) !
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	732	(ft + n), ga := 0]=
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	733	xs @ 0 \<up> (ft - length xs) @ map (\<lambda>i. rec_exec i xs) (take n gs) @ rec_exec (gs ! n) xs # 0 \<up> (length gs - Suc n) @ 0 # 0 \<up> length xs @ anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	734	using a c d e h
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	735	by(simp add: list_update_append nth_append length_replicate split: if_splits del: list_update.simps(2), auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	736	ultimately show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	737	by(simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	738	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	739	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	740	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	741	ultimately show
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	742	"{\<lambda>nl. nl = xs @ 0 # 0 \<up> (ft + length gs) @ anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	743	cn_merge_gs (map rec_ci (take n gs)) ft [+] (case rec_ci (gs ! n) of (gprog, gpara, gn) \<Rightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	744	gprog [+] mv_box gpara (ft + min (length gs) n))
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	745	{\<lambda>nl. nl = xs @ 0 \<up> (ft - length xs) @ map (\<lambda>i. rec_exec i xs) (take n gs) @ rec_exec (gs ! n) xs # 0 \<up> (length gs - Suc n) @ 0 # 0 \<up> length xs @ anything}"
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	746	by simp
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	747	qed
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	748	next
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	749	case False
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	750	have h: "\<not> n < length gs" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	751	hence ind':
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	752	"{\<lambda>nl. nl = xs @ 0 # 0 \<up> (ft + length gs) @ anything} cn_merge_gs (map rec_ci gs) ft
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	753	{\<lambda>nl. nl = xs @ 0 \<up> (ft - length xs) @ map (\<lambda>i. rec_exec i xs) gs @ 0 \<up> Suc (length xs) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	754	using ind
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	755	by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	756	thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	757	using h
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	758	by(simp)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	759	qed
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	760	qed
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	761
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	762	lemma compile_cn_gs_correct:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	763	assumes
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	764	g_cond: "\<forall>g\<in>set gs. terminate g xs \<and>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	765	(\<forall>x xa xb. rec_ci g = (x, xa, xb) \<longrightarrow> (\<forall>xc. {\<lambda>nl. nl = xs @ 0 \<up> (xb - xa) @ xc} x {\<lambda>nl. nl = xs @ rec_exec g xs # 0 \<up> (xb - Suc xa) @ xc}))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	766	and ft: "ft = max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	767	shows
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	768	"{\<lambda>nl. nl = xs @ 0 # 0 \<up> (ft + length gs) @ anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	769	cn_merge_gs (map rec_ci gs) ft
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	770	{\<lambda>nl. nl = xs @ 0 \<up> (ft - length xs) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	771	map (\<lambda>i. rec_exec i xs) gs @ 0 \<up> Suc (length xs) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	772	using assms
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	773	using compile_cn_gs_correct'[of "length gs" gs xs ft ffp anything ]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	774	apply(auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	775	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	776
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	777	lemma length_mvboxes[simp]: "length (mv_boxes aa ba n) = 3*n"
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	778	by(induct n, auto simp: mv_boxes.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	779
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	780	lemma exp_suc: "a\<up>Suc b = a\<up>b @ [a]"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	781	by(simp add: exp_ind del: replicate.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	782
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	783	lemma [simp]:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	784	"\<lbrakk>Suc n \<le> ba - aa; length lm2 = Suc n;
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	785	length lm3 = ba - Suc (aa + n)\<rbrakk>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	786	\<Longrightarrow> (last lm2 # lm3 @ butlast lm2 @ 0 # lm4) ! (ba - aa) = (0::nat)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	787	proof -
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	788	assume h: "Suc n \<le> ba - aa"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	789	and g: "length lm2 = Suc n" "length lm3 = ba - Suc (aa + n)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	790	from h and g have k: "ba - aa = Suc (length lm3 + n)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	791	by arith
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	792	from k show
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	793	"(last lm2 # lm3 @ butlast lm2 @ 0 # lm4) ! (ba - aa) = 0"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	794	apply(simp, insert g)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	795	apply(simp add: nth_append)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	796	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	797	qed
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	798
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	799	lemma [simp]: "length lm1 = aa \<Longrightarrow>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	800	(lm1 @ 0\<up>n @ last lm2 # lm3 @ butlast lm2 @ 0 # lm4) ! (aa + n) = last lm2"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	801	apply(simp add: nth_append)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	802	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	803
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	804	lemma [simp]: "\<lbrakk>Suc n \<le> ba - aa; aa < ba\<rbrakk> \<Longrightarrow>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	805	(ba < Suc (aa + (ba - Suc (aa + n) + n))) = False"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	806	apply arith
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	807	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	808
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	809	lemma [simp]: "\<lbrakk>Suc n \<le> ba - aa; aa < ba; length lm1 = aa;
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	810	length lm2 = Suc n; length lm3 = ba - Suc (aa + n)\<rbrakk>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	811	\<Longrightarrow> (lm1 @ 0\<up>n @ last lm2 # lm3 @ butlast lm2 @ 0 # lm4) ! (ba + n) = 0"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	812	using nth_append[of "lm1 @ (0\<Colon>'a)\<up>n @ last lm2 # lm3 @ butlast lm2"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	813	"(0\<Colon>'a) # lm4" "ba + n"]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	814	apply(simp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	815	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	816
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	817	lemma [simp]:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	818	"\<lbrakk>Suc n \<le> ba - aa; aa < ba; length lm1 = aa; length lm2 = Suc n;
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	819	length lm3 = ba - Suc (aa + n)\<rbrakk>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	820	\<Longrightarrow> (lm1 @ 0\<up>n @ last lm2 # lm3 @ butlast lm2 @ (0::nat) # lm4)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	821	[ba + n := last lm2, aa + n := 0] =
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	822	lm1 @ 0 # 0\<up>n @ lm3 @ lm2 @ lm4"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	823	using list_update_append[of "lm1 @ 0\<up>n @ last lm2 # lm3 @ butlast lm2" "0 # lm4"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	824	"ba + n" "last lm2"]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	825	apply(simp)
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	826	apply(simp add: list_update_append list_update.simps replicate_Suc_iff_anywhere exp_suc
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	827	del: replicate_Suc)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	828	apply(case_tac lm2, simp, simp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	829	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	830
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	831	lemma [simp]:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	832	"\<lbrakk>Suc (length lm1 + n) \<le> ba; length lm2 = Suc n; length lm3 = ba - Suc (length lm1 + n);
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	833	\<not> ba - Suc (length lm1) < ba - Suc (length lm1 + n); \<not> ba + n - length lm1 < n\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	834	\<Longrightarrow> (0::nat) \<up> n @ (last lm2 # lm3 @ butlast lm2 @ 0 # lm4)[ba - length lm1 := last lm2, 0 := 0] =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	835	0 # 0 \<up> n @ lm3 @ lm2 @ lm4"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	836	apply(subgoal_tac "ba - length lm1 = Suc n + length lm3", simp add: list_update.simps list_update_append)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	837	apply(simp add: replicate_Suc_iff_anywhere exp_suc del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	838	apply(case_tac lm2, simp, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	839	apply(auto)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	840	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	841
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	842	lemma mv_boxes_correct:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	843	"\<lbrakk>aa + n \<le> ba; ba > aa; length lm1 = aa; length lm2 = n; length lm3 = ba - aa - n\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	844	\<Longrightarrow> {\<lambda> nl. nl = lm1 @ lm2 @ lm3 @ 0\<up>n @ lm4} (mv_boxes aa ba n)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	845	{\<lambda> nl. nl = lm1 @ 0\<up>n @ lm3 @ lm2 @ lm4}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	846	proof(induct n arbitrary: lm2 lm3 lm4)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	847	case 0
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	848	thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	849	by(simp add: mv_boxes.simps abc_Hoare_halt_def, rule_tac x = 0 in exI, simp add: abc_steps_l.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	850	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	851	case (Suc n)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	852	have ind:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	853	"\<And>lm2 lm3 lm4.
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	854	\<lbrakk>aa + n \<le> ba; aa < ba; length lm1 = aa; length lm2 = n; length lm3 = ba - aa - n\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	855	\<Longrightarrow> {\<lambda>nl. nl = lm1 @ lm2 @ lm3 @ 0 \<up> n @ lm4} mv_boxes aa ba n {\<lambda>nl. nl = lm1 @ 0 \<up> n @ lm3 @ lm2 @ lm4}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	856	by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	857	have h1: "aa + Suc n \<le> ba" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	858	have h2: "aa < ba" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	859	have h3: "length lm1 = aa" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	860	have h4: "length lm2 = Suc n" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	861	have h5: "length lm3 = ba - aa - Suc n" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	862	have "{\<lambda>nl. nl = lm1 @ lm2 @ lm3 @ 0 \<up> Suc n @ lm4} mv_boxes aa ba n [+] mv_box (aa + n) (ba + n)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	863	{\<lambda>nl. nl = lm1 @ 0 \<up> Suc n @ lm3 @ lm2 @ lm4}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	864	proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	865	have "{\<lambda>nl. nl = lm1 @ butlast lm2 @ (last lm2 # lm3) @ 0 \<up> n @ (0 # lm4)} mv_boxes aa ba n
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	866	{\<lambda> nl. nl = lm1 @ 0\<up>n @ (last lm2 # lm3) @ butlast lm2 @ (0 # lm4)}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	867	using h1 h2 h3 h4 h5
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	868	by(rule_tac ind, simp_all)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	869	moreover have " lm1 @ butlast lm2 @ (last lm2 # lm3) @ 0 \<up> n @ (0 # lm4)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	870	= lm1 @ lm2 @ lm3 @ 0 \<up> Suc n @ lm4"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	871	using h4
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	872	by(simp add: replicate_Suc[THEN sym] exp_suc del: replicate_Suc,
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	873	case_tac lm2, simp_all)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	874	ultimately show "{\<lambda>nl. nl = lm1 @ lm2 @ lm3 @ 0 \<up> Suc n @ lm4} mv_boxes aa ba n
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	875	{\<lambda> nl. nl = lm1 @ 0\<up>n @ last lm2 # lm3 @ butlast lm2 @ 0 # lm4}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	876	by (metis append_Cons)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	877	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	878	let ?lm = "lm1 @ 0 \<up> n @ last lm2 # lm3 @ butlast lm2 @ 0 # lm4"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	879	have "{\<lambda>nl. nl = ?lm} mv_box (aa + n) (ba + n)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	880	{\<lambda> nl. nl = ?lm[(ba + n) := ?lm!(aa+n) + ?lm!(ba+n), (aa+n):=0]}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	881	using h1 h2 h3 h4 h5
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	882	by(rule_tac mv_box_correct, simp_all)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	883	moreover have "?lm[(ba + n) := ?lm!(aa+n) + ?lm!(ba+n), (aa+n):=0]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	884	= lm1 @ 0 \<up> Suc n @ lm3 @ lm2 @ lm4"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	885	using h1 h2 h3 h4 h5
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	886	by(auto simp: nth_append list_update_append split: if_splits)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	887	ultimately show "{\<lambda>nl. nl = lm1 @ 0 \<up> n @ last lm2 # lm3 @ butlast lm2 @ 0 # lm4} mv_box (aa + n) (ba + n)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	888	{\<lambda>nl. nl = lm1 @ 0 \<up> Suc n @ lm3 @ lm2 @ lm4}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	889	by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	890	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	891	thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	892	by(simp add: mv_boxes.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	893	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	894
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	895	lemma [simp]:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	896	"\<lbrakk>Suc n \<le> aa - length lm1; length lm1 < aa;
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	897	length lm2 = aa - Suc (length lm1 + n);
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	898	length lm3 = Suc n;
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	899	\<not> aa - Suc (length lm1) < aa - Suc (length lm1 + n);
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	900	\<not> aa + n - length lm1 < n\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	901	\<Longrightarrow> butlast lm3 @ ((0::nat) # lm2 @ 0 \<up> n @ last lm3 # lm4)[0 := last lm3, aa - length lm1 := 0] = lm3 @ lm2 @ 0 # 0 \<up> n @ lm4"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	902	apply(subgoal_tac "aa - length lm1 = length lm2 + Suc n")
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	903	apply(simp add: list_update.simps list_update_append)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	904	apply(simp add: replicate_Suc[THEN sym] exp_suc del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	905	apply(case_tac lm3, simp, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	906	apply(auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	907	done
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	908
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	909	lemma mv_boxes_correct2:
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	910	"\<lbrakk>n \<le> aa - ba;
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	911	ba < aa;
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	912	length (lm1::nat list) = ba;
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	913	length (lm2::nat list) = aa - ba - n;
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	914	length (lm3::nat list) = n\<rbrakk>
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	915	\<Longrightarrow>{\<lambda> nl. nl = lm1 @ 0\<up>n @ lm2 @ lm3 @ lm4}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	916	(mv_boxes aa ba n)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	917	{\<lambda> nl. nl = lm1 @ lm3 @ lm2 @ 0\<up>n @ lm4}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	918	proof(induct n arbitrary: lm2 lm3 lm4)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	919	case 0
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	920	thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	921	by(simp add: mv_boxes.simps abc_Hoare_halt_def, rule_tac x = 0 in exI, simp add: abc_steps_l.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	922	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	923	case (Suc n)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	924	have ind:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	925	"\<And>lm2 lm3 lm4.
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	926	\<lbrakk>n \<le> aa - ba; ba < aa; length lm1 = ba; length lm2 = aa - ba - n; length lm3 = n\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	927	\<Longrightarrow> {\<lambda>nl. nl = lm1 @ 0 \<up> n @ lm2 @ lm3 @ lm4} mv_boxes aa ba n {\<lambda>nl. nl = lm1 @ lm3 @ lm2 @ 0 \<up> n @ lm4}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	928	by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	929	have h1: "Suc n \<le> aa - ba" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	930	have h2: "ba < aa" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	931	have h3: "length lm1 = ba" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	932	have h4: "length lm2 = aa - ba - Suc n" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	933	have h5: "length lm3 = Suc n" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	934	have "{\<lambda>nl. nl = lm1 @ 0 \<up> Suc n @ lm2 @ lm3 @ lm4} mv_boxes aa ba n [+] mv_box (aa + n) (ba + n)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	935	{\<lambda>nl. nl = lm1 @ lm3 @ lm2 @ 0 \<up> Suc n @ lm4}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	936	proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	937	have "{\<lambda> nl. nl = lm1 @ 0 \<up> n @ (0 # lm2) @ (butlast lm3) @ (last lm3 # lm4)} mv_boxes aa ba n
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	938	{\<lambda> nl. nl = lm1 @ butlast lm3 @ (0 # lm2) @ 0\<up>n @ (last lm3 # lm4)}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	939	using h1 h2 h3 h4 h5
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	940	by(rule_tac ind, simp_all)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	941	moreover have "lm1 @ 0 \<up> n @ (0 # lm2) @ (butlast lm3) @ (last lm3 # lm4)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	942	= lm1 @ 0 \<up> Suc n @ lm2 @ lm3 @ lm4"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	943	using h5
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	944	by(simp add: replicate_Suc_iff_anywhere exp_suc
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	945	del: replicate_Suc, case_tac lm3, simp_all)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	946	ultimately show "{\<lambda>nl. nl = lm1 @ 0 \<up> Suc n @ lm2 @ lm3 @ lm4} mv_boxes aa ba n
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	947	{\<lambda> nl. nl = lm1 @ butlast lm3 @ (0 # lm2) @ 0\<up>n @ (last lm3 # lm4)}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	948	by metis
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	949	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	950	thm mv_box_correct
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	951	let ?lm = "lm1 @ butlast lm3 @ (0 # lm2) @ 0 \<up> n @ last lm3 # lm4"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	952	have "{\<lambda>nl. nl = ?lm} mv_box (aa + n) (ba + n)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	953	{\<lambda>nl. nl = ?lm[ba+n := ?lm!(aa+n)+?lm!(ba+n), (aa+n):=0]}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	954	using h1 h2 h3 h4 h5
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	955	by(rule_tac mv_box_correct, simp_all)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	956	moreover have "?lm[ba+n := ?lm!(aa+n)+?lm!(ba+n), (aa+n):=0]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	957	= lm1 @ lm3 @ lm2 @ 0 \<up> Suc n @ lm4"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	958	using h1 h2 h3 h4 h5
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	959	by(auto simp: nth_append list_update_append split: if_splits)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	960	ultimately show "{\<lambda>nl. nl = lm1 @ butlast lm3 @ (0 # lm2) @ 0 \<up> n @ last lm3 # lm4} mv_box (aa + n) (ba + n)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	961	{\<lambda>nl. nl = lm1 @ lm3 @ lm2 @ 0 \<up> Suc n @ lm4}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	962	by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	963	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	964	thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	965	by(simp add: mv_boxes.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	966	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	967
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	968	lemma save_paras:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	969	"{\<lambda>nl. nl = xs @ 0 \<up> (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) - length xs) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	970	map (\<lambda>i. rec_exec i xs) gs @ 0 \<up> Suc (length xs) @ anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	971	mv_boxes 0 (Suc (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) + length gs)) (length xs)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	972	{\<lambda>nl. nl = 0 \<up> max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) @ map (\<lambda>i. rec_exec i xs) gs @ 0 # xs @ anything}"
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	973	proof -
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	974	let ?ft = "max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	975	have "{\<lambda>nl. nl = [] @ xs @ (0\<up>(?ft - length xs) @ map (\<lambda>i. rec_exec i xs) gs @ [0]) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	976	0 \<up> (length xs) @ anything} mv_boxes 0 (Suc ?ft + length gs) (length xs)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	977	{\<lambda>nl. nl = [] @ 0 \<up> (length xs) @ (0\<up>(?ft - length xs) @ map (\<lambda>i. rec_exec i xs) gs @ [0]) @ xs @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	978	by(rule_tac mv_boxes_correct, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	979	thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	980	by(simp add: replicate_merge_anywhere)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	981	qed
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	982
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	983	lemma [intro]:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	984	"length gs \<le> ffp \<Longrightarrow> length gs \<le> max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	985	apply(rule_tac min_max.le_supI2)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	986	apply(simp add: Max_ge_iff)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	987	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	988
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	989	lemma restore_new_paras:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	990	"ffp \<ge> length gs
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	991	\<Longrightarrow> {\<lambda>nl. nl = 0 \<up> max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) @ map (\<lambda>i. rec_exec i xs) gs @ 0 # xs @ anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	992	mv_boxes (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))) 0 (length gs)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	993	{\<lambda>nl. nl = map (\<lambda>i. rec_exec i xs) gs @ 0 \<up> max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) @ 0 # xs @ anything}"
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	994	proof -
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	995	let ?ft = "max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	996	assume j: "ffp \<ge> length gs"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	997	hence "{\<lambda> nl. nl = [] @ 0\<up>length gs @ 0\<up>(?ft - length gs) @ map (\<lambda>i. rec_exec i xs) gs @ ((0 # xs) @ anything)}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	998	mv_boxes ?ft 0 (length gs)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	999	{\<lambda> nl. nl = [] @ map (\<lambda>i. rec_exec i xs) gs @ 0\<up>(?ft - length gs) @ 0\<up>length gs @ ((0 # xs) @ anything)}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1000	by(rule_tac mv_boxes_correct2, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1001	moreover have "?ft \<ge> length gs"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1002	using j
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1003	by(auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1004	ultimately show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1005	using j
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1006	by(simp add: replicate_merge_anywhere le_add_diff_inverse)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1007	qed
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1008
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1009	lemma [intro]: "ffp \<le> max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1010	apply(rule_tac min_max.le_supI2)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1011	apply(rule_tac Max_ge, auto)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1012	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1013
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1014	declare max_less_iff_conj[simp del]
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1015
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1016	lemma save_rs:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1017	"\<lbrakk>far = length gs;
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1018	ffp \<le> max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)));
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1019	far < ffp\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1020	\<Longrightarrow> {\<lambda>nl. nl = map (\<lambda>i. rec_exec i xs) gs @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1021	rec_exec (Cn (length xs) f gs) xs # 0 \<up> max (Suc (length xs))
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1022	(Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) @ xs @ anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1023	mv_box far (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))))
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1024	{\<lambda>nl. nl = map (\<lambda>i. rec_exec i xs) gs @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1025	0 \<up> (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) - length gs) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1026	rec_exec (Cn (length xs) f gs) xs # 0 \<up> length gs @ xs @ anything}"
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1027	proof -
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1028	let ?ft = "max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1029	thm mv_box_correct
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1030	let ?lm= " map (\<lambda>i. rec_exec i xs) gs @ rec_exec (Cn (length xs) f gs) xs # 0 \<up> ?ft @ xs @ anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1031	assume h: "far = length gs" "ffp \<le> ?ft" "far < ffp"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1032	hence "{\<lambda> nl. nl = ?lm} mv_box far ?ft {\<lambda> nl. nl = ?lm[?ft := ?lm!far + ?lm!?ft, far := 0]}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1033	apply(rule_tac mv_box_correct)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1034	by(case_tac "rec_ci a", auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1035	moreover have "?lm[?ft := ?lm!far + ?lm!?ft, far := 0]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1036	= map (\<lambda>i. rec_exec i xs) gs @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1037	0 \<up> (?ft - length gs) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1038	rec_exec (Cn (length xs) f gs) xs # 0 \<up> length gs @ xs @ anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1039	using h
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1040	apply(simp add: nth_append)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1041	using list_update_length[of "map (\<lambda>i. rec_exec i xs) gs @ rec_exec (Cn (length xs) f gs) xs #
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1042	0 \<up> (?ft - Suc (length gs))" 0 "0 \<up> length gs @ xs @ anything" "rec_exec (Cn (length xs) f gs) xs"]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1043	apply(simp add: replicate_merge_anywhere replicate_Suc_iff_anywhere del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1044	by(simp add: list_update_append list_update.simps replicate_Suc_iff_anywhere del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1045	ultimately show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1046	by(simp)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1047	qed
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1048
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1049	lemma [simp]: "length (empty_boxes n) = 2*n"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1050	apply(induct n, simp, simp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1051	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1052
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1053	lemma empty_one_box_correct:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1054	"{\<lambda>nl. nl = 0 \<up> n @ x # lm} [Dec n 2, Goto 0] {\<lambda>nl. nl = 0 # 0 \<up> n @ lm}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1055	proof(induct x)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1056	case 0
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1057	thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1058	by(simp add: abc_Hoare_halt_def,
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1059	rule_tac x = 1 in exI, simp add: abc_steps_l.simps
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1060	abc_step_l.simps abc_fetch.simps abc_lm_v.simps nth_append abc_lm_s.simps
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1061	replicate_Suc[THEN sym] exp_suc del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1062	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1063	case (Suc x)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1064	have "{\<lambda>nl. nl = 0 \<up> n @ x # lm} [Dec n 2, Goto 0] {\<lambda>nl. nl = 0 # 0 \<up> n @ lm}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1065	by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1066	then obtain stp where "abc_steps_l (0, 0 \<up> n @ x # lm) [Dec n 2, Goto 0] stp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1067	= (Suc (Suc 0), 0 # 0 \<up> n @ lm)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1068	apply(auto simp: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1069	by(case_tac "abc_steps_l (0, 0 \<up> n @ x # lm) [Dec n 2, Goto 0] na", simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1070	moreover have "abc_steps_l (0, 0\<up>n @ Suc x # lm) [Dec n 2, Goto 0] (Suc (Suc 0))
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1071	= (0, 0 \<up> n @ x # lm)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1072	by(auto simp: abc_steps_l.simps abc_step_l.simps abc_fetch.simps abc_lm_v.simps
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1073	nth_append abc_lm_s.simps list_update.simps list_update_append)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1074	ultimately have "abc_steps_l (0, 0\<up>n @ Suc x # lm) [Dec n 2, Goto 0] (Suc (Suc 0) + stp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1075	= (Suc (Suc 0), 0 # 0\<up>n @ lm)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1076	by(simp only: abc_steps_add)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1077	thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1078	apply(simp add: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1079	apply(rule_tac x = "Suc (Suc stp)" in exI, simp)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1080	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1081	qed
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1082
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1083	lemma empty_boxes_correct:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1084	"length lm \<ge> n \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1085	{\<lambda> nl. nl = lm} empty_boxes n {\<lambda> nl. nl = 0\<up>n @ drop n lm}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1086	proof(induct n)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1087	case 0
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1088	thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1089	by(simp add: empty_boxes.simps abc_Hoare_halt_def,
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1090	rule_tac x = 0 in exI, simp add: abc_steps_l.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1091	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1092	case (Suc n)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1093	have ind: "n \<le> length lm \<Longrightarrow> {\<lambda>nl. nl = lm} empty_boxes n {\<lambda>nl. nl = 0 \<up> n @ drop n lm}" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1094	have h: "Suc n \<le> length lm" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1095	have "{\<lambda>nl. nl = lm} empty_boxes n [+] [Dec n 2, Goto 0] {\<lambda>nl. nl = 0 # 0 \<up> n @ drop (Suc n) lm}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1096	proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1097	show "{\<lambda>nl. nl = lm} empty_boxes n {\<lambda>nl. nl = 0 \<up> n @ drop n lm}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1098	using h
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1099	by(rule_tac ind, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1100	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1101	show "{\<lambda>nl. nl = 0 \<up> n @ drop n lm} [Dec n 2, Goto 0] {\<lambda>nl. nl = 0 # 0 \<up> n @ drop (Suc n) lm}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1102	using empty_one_box_correct[of n "lm ! n" "drop (Suc n) lm"]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1103	using h
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1104	by(simp add: nth_drop')
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1105	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1106	thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1107	by(simp add: empty_boxes.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1108	qed
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1109
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1110	lemma [simp]: "length gs \<le> ffp \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1111	length gs + (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) - length gs) =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1112	max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1113	apply(rule_tac le_add_diff_inverse)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1114	apply(rule_tac min_max.le_supI2)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1115	apply(simp add: Max_ge_iff)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1116	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1117
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1118
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1119	lemma clean_paras:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1120	"ffp \<ge> length gs \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1121	{\<lambda>nl. nl = map (\<lambda>i. rec_exec i xs) gs @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1122	0 \<up> (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) - length gs) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1123	rec_exec (Cn (length xs) f gs) xs # 0 \<up> length gs @ xs @ anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1124	empty_boxes (length gs)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1125	{\<lambda>nl. nl = 0 \<up> max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1126	rec_exec (Cn (length xs) f gs) xs # 0 \<up> length gs @ xs @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1127	proof-
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1128	let ?ft = "max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1129	assume h: "length gs \<le> ffp"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1130	let ?lm = "map (\<lambda>i. rec_exec i xs) gs @ 0 \<up> (?ft - length gs) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1131	rec_exec (Cn (length xs) f gs) xs # 0 \<up> length gs @ xs @ anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1132	have "{\<lambda> nl. nl = ?lm} empty_boxes (length gs) {\<lambda> nl. nl = 0\<up>length gs @ drop (length gs) ?lm}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1133	by(rule_tac empty_boxes_correct, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1134	moreover have "0\<up>length gs @ drop (length gs) ?lm
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1135	= 0 \<up> ?ft @ rec_exec (Cn (length xs) f gs) xs # 0 \<up> length gs @ xs @ anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1136	using h
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1137	by(simp add: replicate_merge_anywhere)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1138	ultimately show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1139	by metis
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1140	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1141
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1142
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1143	lemma restore_rs:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1144	"{\<lambda>nl. nl = 0 \<up> max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1145	rec_exec (Cn (length xs) f gs) xs # 0 \<up> length gs @ xs @ anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1146	mv_box (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))) (length xs)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1147	{\<lambda>nl. nl = 0 \<up> length xs @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1148	rec_exec (Cn (length xs) f gs) xs #
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1149	0 \<up> (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) - (length xs)) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1150	0 \<up> length gs @ xs @ anything}"
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1151	proof -
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1152	let ?ft = "max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1153	let ?lm = "0\<up>(length xs) @ 0\<up>(?ft - (length xs)) @ rec_exec (Cn (length xs) f gs) xs # 0 \<up> length gs @ xs @ anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1154	thm mv_box_correct
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1155	have "{\<lambda> nl. nl = ?lm} mv_box ?ft (length xs) {\<lambda> nl. nl = ?lm[length xs := ?lm!?ft + ?lm!(length xs), ?ft := 0]}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1156	by(rule_tac mv_box_correct, simp, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1157	moreover have "?lm[length xs := ?lm!?ft + ?lm!(length xs), ?ft := 0]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1158	= 0 \<up> length xs @ rec_exec (Cn (length xs) f gs) xs # 0 \<up> (?ft - (length xs)) @ 0 \<up> length gs @ xs @ anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1159	apply(auto simp: list_update_append nth_append)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1160	apply(case_tac ?ft, simp_all add: Suc_diff_le list_update.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1161	apply(simp add: exp_suc replicate_Suc[THEN sym] del: replicate_Suc)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1162	done
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1163	ultimately show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1164	by(simp add: replicate_merge_anywhere)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1165	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1166
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1167	lemma restore_orgin_paras:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1168	"{\<lambda>nl. nl = 0 \<up> length xs @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1169	rec_exec (Cn (length xs) f gs) xs #
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1170	0 \<up> (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) - length xs) @ 0 \<up> length gs @ xs @ anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1171	mv_boxes (Suc (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) + length gs)) 0 (length xs)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1172	{\<lambda>nl. nl = xs @ rec_exec (Cn (length xs) f gs) xs # 0 \<up>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1173	(max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) + length gs) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1174	proof -
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1175	let ?ft = "max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1176	thm mv_boxes_correct2
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1177	have "{\<lambda> nl. nl = [] @ 0\<up>(length xs) @ (rec_exec (Cn (length xs) f gs) xs # 0 \<up> (?ft - length xs) @ 0 \<up> length gs) @ xs @ anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1178	mv_boxes (Suc ?ft + length gs) 0 (length xs)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1179	{\<lambda> nl. nl = [] @ xs @ (rec_exec (Cn (length xs) f gs) xs # 0 \<up> (?ft - length xs) @ 0 \<up> length gs) @ 0\<up>length xs @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1180	by(rule_tac mv_boxes_correct2, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1181	thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1182	by(simp add: replicate_merge_anywhere)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1183	qed
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1184
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1185	lemma compile_cn_correct':
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1186	assumes f_ind:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1187	"\<And> anything r. rec_exec f (map (\<lambda>g. rec_exec g xs) gs) = rec_exec (Cn (length xs) f gs) xs \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1188	{\<lambda>nl. nl = map (\<lambda>g. rec_exec g xs) gs @ 0 \<up> (ffp - far) @ anything} fap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1189	{\<lambda>nl. nl = map (\<lambda>g. rec_exec g xs) gs @ rec_exec (Cn (length xs) f gs) xs # 0 \<up> (ffp - Suc far) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1190	and compile: "rec_ci f = (fap, far, ffp)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1191	and term_f: "terminate f (map (\<lambda>g. rec_exec g xs) gs)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1192	and g_cond: "\<forall>g\<in>set gs. terminate g xs \<and>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1193	(\<forall>x xa xb. rec_ci g = (x, xa, xb) \<longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1194	(\<forall>xc. {\<lambda>nl. nl = xs @ 0 \<up> (xb - xa) @ xc} x {\<lambda>nl. nl = xs @ rec_exec g xs # 0 \<up> (xb - Suc xa) @ xc}))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1195	shows
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1196	"{\<lambda>nl. nl = xs @ 0 # 0 \<up> (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) + length gs) @ anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1197	cn_merge_gs (map rec_ci gs) (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))) [+]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1198	(mv_boxes 0 (Suc (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) + length gs)) (length xs) [+]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1199	(mv_boxes (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))) 0 (length gs) [+]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1200	(fap [+] (mv_box far (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))) [+]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1201	(empty_boxes (length gs) [+]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1202	(mv_box (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))) (length xs) [+]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1203	mv_boxes (Suc (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) + length gs)) 0 (length xs)))))))
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1204	{\<lambda>nl. nl = xs @ rec_exec (Cn (length xs) f gs) xs #
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1205	0 \<up> (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) + length gs) @ anything}"
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1206	proof -
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1207	let ?ft = "max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1208	let ?A = "cn_merge_gs (map rec_ci gs) ?ft"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1209	let ?B = "mv_boxes 0 (Suc (?ft+length gs)) (length xs)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1210	let ?C = "mv_boxes ?ft 0 (length gs)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1211	let ?D = fap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1212	let ?E = "mv_box far ?ft"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1213	let ?F = "empty_boxes (length gs)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1214	let ?G = "mv_box ?ft (length xs)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1215	let ?H = "mv_boxes (Suc (?ft + length gs)) 0 (length xs)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1216	let ?P1 = "\<lambda>nl. nl = xs @ 0 # 0 \<up> (?ft + length gs) @ anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1217	let ?S = "\<lambda>nl. nl = xs @ rec_exec (Cn (length xs) f gs) xs # 0 \<up> (?ft + length gs) @ anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1218	let ?Q1 = "\<lambda> nl. nl = xs @ 0\<up>(?ft - length xs) @ map (\<lambda> i. rec_exec i xs) gs @ 0\<up>(Suc (length xs)) @ anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1219	show "{?P1} (?A [+] (?B [+] (?C [+] (?D [+] (?E [+] (?F [+] (?G [+] ?H))))))) {?S}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1220	proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1221	show "{?P1} ?A {?Q1}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1222	using g_cond
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1223	by(rule_tac compile_cn_gs_correct, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1224	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1225	let ?Q2 = "\<lambda>nl. nl = 0 \<up> ?ft @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1226	map (\<lambda>i. rec_exec i xs) gs @ 0 # xs @ anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1227	show "{?Q1} (?B [+] (?C [+] (?D [+] (?E [+] (?F [+] (?G [+] ?H)))))) {?S}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1228	proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1229	show "{?Q1} ?B {?Q2}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1230	by(rule_tac save_paras)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1231	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1232	let ?Q3 = "\<lambda> nl. nl = map (\<lambda>i. rec_exec i xs) gs @ 0\<up>?ft @ 0 # xs @ anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1233	show "{?Q2} (?C [+] (?D [+] (?E [+] (?F [+] (?G [+] ?H))))) {?S}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1234	proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1235	have "ffp \<ge> length gs"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1236	using compile term_f
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1237	apply(subgoal_tac "length gs = far")
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1238	apply(drule_tac footprint_ge, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1239	by(drule_tac param_pattern, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1240	thus "{?Q2} ?C {?Q3}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1241	by(erule_tac restore_new_paras)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1242	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1243	let ?Q4 = "\<lambda> nl. nl = map (\<lambda>i. rec_exec i xs) gs @ rec_exec (Cn (length xs) f gs) xs # 0\<up>?ft @ xs @ anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1244	have a: "far = length gs"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1245	using compile term_f
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1246	by(drule_tac param_pattern, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1247	have b:"?ft \<ge> ffp"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1248	by auto
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1249	have c: "ffp > far"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1250	using compile
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1251	by(erule_tac footprint_ge)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1252	show "{?Q3} (?D [+] (?E [+] (?F [+] (?G [+] ?H)))) {?S}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1253	proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1254	have "{\<lambda>nl. nl = map (\<lambda>g. rec_exec g xs) gs @ 0 \<up> (ffp - far) @ 0\<up>(?ft - ffp + far) @ 0 # xs @ anything} fap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1255	{\<lambda>nl. nl = map (\<lambda>g. rec_exec g xs) gs @ rec_exec (Cn (length xs) f gs) xs #
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1256	0 \<up> (ffp - Suc far) @ 0\<up>(?ft - ffp + far) @ 0 # xs @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1257	by(rule_tac f_ind, simp add: rec_exec.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1258	thus "{?Q3} fap {?Q4}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1259	using a b c
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1260	by(simp add: replicate_merge_anywhere,
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1261	case_tac "?ft", simp_all add: exp_suc del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1262	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1263	let ?Q5 = "\<lambda>nl. nl = map (\<lambda>i. rec_exec i xs) gs @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1264	0\<up>(?ft - length gs) @ rec_exec (Cn (length xs) f gs) xs # 0\<up>(length gs)@ xs @ anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1265	show "{?Q4} (?E [+] (?F [+] (?G [+] ?H))) {?S}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1266	proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1267	from a b c show "{?Q4} ?E {?Q5}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1268	by(erule_tac save_rs, simp_all)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1269	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1270	let ?Q6 = "\<lambda>nl. nl = 0\<up>?ft @ rec_exec (Cn (length xs) f gs) xs # 0\<up>(length gs)@ xs @ anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1271	show "{?Q5} (?F [+] (?G [+] ?H)) {?S}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1272	proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1273	have "length gs \<le> ffp" using a b c
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1274	by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1275	thus "{?Q5} ?F {?Q6}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1276	by(erule_tac clean_paras)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1277	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1278	let ?Q7 = "\<lambda>nl. nl = 0\<up>length xs @ rec_exec (Cn (length xs) f gs) xs # 0\<up>(?ft - (length xs)) @ 0\<up>(length gs)@ xs @ anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1279	show "{?Q6} (?G [+] ?H) {?S}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1280	proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1281	show "{?Q6} ?G {?Q7}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1282	by(rule_tac restore_rs)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1283	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1284	show "{?Q7} ?H {?S}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1285	by(rule_tac restore_orgin_paras)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1286	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1287	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1288	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1289	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1290	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1291	qed
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1292	qed
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1293	qed
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1294
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1295	lemma compile_cn_correct:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1296	assumes termi_f: "terminate f (map (\<lambda>g. rec_exec g xs) gs)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1297	and f_ind: "\<And>ap arity fp anything.
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1298	rec_ci f = (ap, arity, fp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1299	\<Longrightarrow> {\<lambda>nl. nl = map (\<lambda>g. rec_exec g xs) gs @ 0 \<up> (fp - arity) @ anything} ap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1300	{\<lambda>nl. nl = map (\<lambda>g. rec_exec g xs) gs @ rec_exec f (map (\<lambda>g. rec_exec g xs) gs) # 0 \<up> (fp - Suc arity) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1301	and g_cond:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1302	"\<forall>g\<in>set gs. terminate g xs \<and>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1303	(\<forall>x xa xb. rec_ci g = (x, xa, xb) \<longrightarrow> (\<forall>xc. {\<lambda>nl. nl = xs @ 0 \<up> (xb - xa) @ xc} x {\<lambda>nl. nl = xs @ rec_exec g xs # 0 \<up> (xb - Suc xa) @ xc}))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1304	and compile: "rec_ci (Cn n f gs) = (ap, arity, fp)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1305	and len: "length xs = n"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1306	shows "{\<lambda>nl. nl = xs @ 0 \<up> (fp - arity) @ anything} ap {\<lambda>nl. nl = xs @ rec_exec (Cn n f gs) xs # 0 \<up> (fp - Suc arity) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1307	proof(case_tac "rec_ci f")
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1308	fix fap far ffp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1309	assume h: "rec_ci f = (fap, far, ffp)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1310	then have f_newind: "\<And> anything .{\<lambda>nl. nl = map (\<lambda>g. rec_exec g xs) gs @ 0 \<up> (ffp - far) @ anything} fap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1311	{\<lambda>nl. nl = map (\<lambda>g. rec_exec g xs) gs @ rec_exec f (map (\<lambda>g. rec_exec g xs) gs) # 0 \<up> (ffp - Suc far) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1312	by(rule_tac f_ind, simp_all)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1313	thus "{\<lambda>nl. nl = xs @ 0 \<up> (fp - arity) @ anything} ap {\<lambda>nl. nl = xs @ rec_exec (Cn n f gs) xs # 0 \<up> (fp - Suc arity) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1314	using compile len h termi_f g_cond
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1315	apply(auto simp: rec_ci.simps abc_comp_commute)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1316	apply(rule_tac compile_cn_correct', simp_all)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1317	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1318	qed
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1319
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1320	lemma [simp]:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1321	"\<lbrakk>length xs = n; ft = max (n+3) (max fft gft)\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1322	\<Longrightarrow> {\<lambda>nl. nl = xs @ 0 # 0 \<up> (ft - n) @ anything} mv_box n ft
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1323	{\<lambda>nl. nl = xs @ 0 # 0 \<up> (ft - n) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1324	using mv_box_correct[of n ft "xs @ 0 # 0 \<up> (ft - n) @ anything"]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1325	by(auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1326
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1327	lemma [simp]: "length xs < max (length xs + 3) (max fft gft)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1328	by auto
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1329
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1330	lemma save_init_rs:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1331	"\<lbrakk>length xs = n; ft = max (n+3) (max fft gft)\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1332	\<Longrightarrow> {\<lambda>nl. nl = xs @ rec_exec f xs # 0 \<up> (ft - n) @ anything} mv_box n (Suc n)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1333	{\<lambda>nl. nl = xs @ 0 # rec_exec f xs # 0 \<up> (ft - Suc n) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1334	using mv_box_correct[of n "Suc n" "xs @ rec_exec f xs # 0 \<up> (ft - n) @ anything"]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1335	apply(auto simp: list_update_append list_update.simps nth_append split: if_splits)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1336	apply(case_tac "(max (length xs + 3) (max fft gft))", simp_all add: list_update.simps Suc_diff_le)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1337	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1338
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1339	lemma [simp]: "n + (2::nat) < max (n + 3) (max fft gft)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1340	by auto
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1341
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1342	lemma [simp]: "n < max (n + (3::nat)) (max fft gft)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1343	by auto
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1344
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1345	lemma [simp]:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1346	"length xs = n \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1347	{\<lambda>nl. nl = xs @ x # 0 \<up> (max (n + (3::nat)) (max fft gft) - n) @ anything} mv_box n (max (n + 3) (max fft gft))
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1348	{\<lambda>nl. nl = xs @ 0 \<up> (max (n + 3) (max fft gft) - n) @ x # anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1349	proof -
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1350	assume h: "length xs = n"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1351	let ?ft = "max (n+3) (max fft gft)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1352	let ?lm = "xs @ x # 0\<up>(?ft - Suc n) @ 0 # anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1353	have g: "?ft > n + 2"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1354	by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1355	thm mv_box_correct
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1356	have a: "{\<lambda> nl. nl = ?lm} mv_box n ?ft {\<lambda> nl. nl = ?lm[?ft := ?lm!n + ?lm!?ft, n := 0]}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1357	using h
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1358	by(rule_tac mv_box_correct, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1359	have b:"?lm = xs @ x # 0 \<up> (max (n + 3) (max fft gft) - n) @ anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1360	by(case_tac ?ft, simp_all add: Suc_diff_le exp_suc del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1361	have c: "?lm[?ft := ?lm!n + ?lm!?ft, n := 0] = xs @ 0 \<up> (max (n + 3) (max fft gft) - n) @ x # anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1362	using h g
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1363	apply(auto simp: nth_append list_update_append split: if_splits)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1364	using list_update_append[of "x # 0 \<up> (max (length xs + 3) (max fft gft) - Suc (length xs))" "0 # anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1365	"max (length xs + 3) (max fft gft) - length xs" "x"]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1366	apply(auto simp: if_splits)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1367	apply(simp add: list_update.simps replicate_Suc[THEN sym] del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1368	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1369	from a c show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1370	using h
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1371	apply(simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1372	using b
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1373	by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1374	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1375
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1376	lemma [simp]: "max n (Suc n) < Suc (Suc (max (n + 3) (max fft gft) + length anything - Suc 0))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1377	by arith
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1378
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1379	lemma [simp]: "Suc n < max (n + 3) (max fft gft)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1380	by arith
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1381
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1382	lemma [simp]:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1383	"length xs = n
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1384	\<Longrightarrow> {\<lambda>nl. nl = xs @ rec_exec f xs # 0 \<up> (max (n + 3) (max fft gft) - Suc n) @ x # anything} mv_box n (Suc n)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1385	{\<lambda>nl. nl = xs @ 0 # rec_exec f xs # 0 \<up> (max (n + 3) (max fft gft) - Suc (Suc n)) @ x # anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1386	using mv_box_correct[of n "Suc n" "xs @ rec_exec f xs # 0 \<up> (max (n + 3) (max fft gft) - Suc n) @ x # anything"]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1387	apply(simp add: nth_append list_update_append list_update.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1388	apply(case_tac "max (n + 3) (max fft gft)", simp_all)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1389	apply(case_tac nat, simp_all add: Suc_diff_le list_update.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1390	done
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1391
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1392	lemma abc_append_frist_steps_eq_pre:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1393	assumes notfinal: "abc_notfinal (abc_steps_l (0, lm) A n) A"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1394	and notnull: "A \<noteq> []"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1395	shows "abc_steps_l (0, lm) (A @ B) n = abc_steps_l (0, lm) A n"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1396	using notfinal
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1397	proof(induct n)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1398	case 0
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1399	thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1400	by(simp add: abc_steps_l.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1401	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1402	case (Suc n)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1403	have ind: "abc_notfinal (abc_steps_l (0, lm) A n) A \<Longrightarrow> abc_steps_l (0, lm) (A @ B) n = abc_steps_l (0, lm) A n"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1404	by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1405	have h: "abc_notfinal (abc_steps_l (0, lm) A (Suc n)) A" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1406	then have a: "abc_notfinal (abc_steps_l (0, lm) A n) A"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1407	by(simp add: notfinal_Suc)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1408	then have b: "abc_steps_l (0, lm) (A @ B) n = abc_steps_l (0, lm) A n"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1409	using ind by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1410	obtain s lm' where c: "abc_steps_l (0, lm) A n = (s, lm')"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1411	by (metis prod.exhaust)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1412	then have d: "s < length A \<and> abc_steps_l (0, lm) (A @ B) n = (s, lm')"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1413	using a b by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1414	thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1415	using c
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1416	by(simp add: abc_step_red2 abc_fetch.simps abc_step_l.simps nth_append)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1417	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1418
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1419	lemma abc_append_first_step_eq_pre:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1420	"st < length A
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1421	\<Longrightarrow> abc_step_l (st, lm) (abc_fetch st (A @ B)) =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1422	abc_step_l (st, lm) (abc_fetch st A)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1423	by(simp add: abc_step_l.simps abc_fetch.simps nth_append)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1424
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1425	lemma abc_append_frist_steps_halt_eq':
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1426	assumes final: "abc_steps_l (0, lm) A n = (length A, lm')"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1427	and notnull: "A \<noteq> []"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1428	shows "\<exists> n'. abc_steps_l (0, lm) (A @ B) n' = (length A, lm')"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1429	proof -
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1430	have "\<exists> n'. abc_notfinal (abc_steps_l (0, lm) A n') A \<and>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1431	abc_final (abc_steps_l (0, lm) A (Suc n')) A"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1432	using assms
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1433	by(rule_tac n = n in abc_before_final, simp_all)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1434	then obtain na where a:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1435	"abc_notfinal (abc_steps_l (0, lm) A na) A \<and>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1436	abc_final (abc_steps_l (0, lm) A (Suc na)) A" ..
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1437	obtain sa lma where b: "abc_steps_l (0, lm) A na = (sa, lma)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1438	by (metis prod.exhaust)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1439	then have c: "abc_steps_l (0, lm) (A @ B) na = (sa, lma)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1440	using a abc_append_frist_steps_eq_pre[of lm A na B] assms
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1441	by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1442	have d: "sa < length A" using b a by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1443	then have e: "abc_step_l (sa, lma) (abc_fetch sa (A @ B)) =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1444	abc_step_l (sa, lma) (abc_fetch sa A)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1445	by(rule_tac abc_append_first_step_eq_pre)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1446	from a have "abc_steps_l (0, lm) A (Suc na) = (length A, lm')"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1447	using final equal_when_halt
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1448	by(case_tac "abc_steps_l (0, lm) A (Suc na)" , simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1449	then have "abc_steps_l (0, lm) (A @ B) (Suc na) = (length A, lm')"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1450	using a b c e
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1451	by(simp add: abc_step_red2)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1452	thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1453	by blast
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1454	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1455
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1456	lemma abc_append_frist_steps_halt_eq:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1457	assumes final: "abc_steps_l (0, lm) A n = (length A, lm')"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1458	shows "\<exists> n'. abc_steps_l (0, lm) (A @ B) n' = (length A, lm')"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1459	using final
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1460	apply(case_tac "A = []")
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1461	apply(rule_tac x = 0 in exI, simp add: abc_steps_l.simps abc_exec_null)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1462	apply(rule_tac abc_append_frist_steps_halt_eq', simp_all)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1463	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1464
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1465	lemma [simp]: "Suc (Suc (max (length xs + 3) (max fft gft) - Suc (Suc (length xs))))
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1466	= max (length xs + 3) (max fft gft) - (length xs)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1467	by arith
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1468
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1469	lemma [simp]: "\<lbrakk>ft = max (n + 3) (max fft gft); length xs = n\<rbrakk> \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1470	{\<lambda>nl. nl = xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (ft - Suc (Suc n)) @ Suc y # anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1471	[Dec ft (length gap + 7)]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1472	{\<lambda>nl. nl = xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (ft - Suc (Suc n)) @ y # anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1473	apply(simp add: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1474	apply(rule_tac x = 1 in exI)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1475	apply(auto simp: abc_steps_l.simps abc_step_l.simps abc_fetch.simps nth_append abc_lm_v.simps abc_lm_s.simps list_update_append)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1476	using list_update_length
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1477	[of "(x - Suc y) # rec_exec (Pr (length xs) f g) (xs @ [x - Suc y]) #
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1478	0 \<up> (max (length xs + 3) (max fft gft) - Suc (Suc (length xs)))" "Suc y" anything y]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1479	apply(simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1480	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1481
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1482	lemma adjust_paras':
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1483	"length xs = n \<Longrightarrow> {\<lambda>nl. nl = xs @ x # y # anything} [Inc n] [+] [Dec (Suc n) 2, Goto 0]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1484	{\<lambda>nl. nl = xs @ Suc x # 0 # anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1485	proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1486	assume "length xs = n"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1487	thus "{\<lambda>nl. nl = xs @ x # y # anything} [Inc n] {\<lambda> nl. nl = xs @ Suc x # y # anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1488	apply(simp add: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1489	apply(rule_tac x = 1 in exI, simp add: abc_steps_l.simps abc_step_l.simps abc_fetch.simps abc_comp.simps
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1490	abc_lm_v.simps abc_lm_s.simps nth_append list_update_append list_update.simps)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1491	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1492	next
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1493	assume h: "length xs = n"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1494	thus "{\<lambda>nl. nl = xs @ Suc x # y # anything} [Dec (Suc n) 2, Goto 0] {\<lambda>nl. nl = xs @ Suc x # 0 # anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1495	proof(induct y)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1496	case 0
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1497	thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1498	apply(simp add: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1499	apply(rule_tac x = 1 in exI, simp add: abc_steps_l.simps abc_step_l.simps abc_fetch.simps abc_comp.simps
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1500	abc_lm_v.simps abc_lm_s.simps nth_append list_update_append list_update.simps)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1501	done
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1502	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1503	case (Suc y)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1504	have "length xs = n \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1505	{\<lambda>nl. nl = xs @ Suc x # y # anything} [Dec (Suc n) 2, Goto 0] {\<lambda>nl. nl = xs @ Suc x # 0 # anything}" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1506	then obtain stp where
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1507	"abc_steps_l (0, xs @ Suc x # y # anything) [Dec (Suc n) 2, Goto 0] stp = (2, xs @ Suc x # 0 # anything)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1508	using h
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1509	apply(auto simp: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1510	by(case_tac "abc_steps_l (0, xs @ Suc x # y # anything) [Dec (Suc (length xs)) 2, Goto 0] n",
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1511	simp_all add: numeral_2_eq_2)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1512	moreover have "abc_steps_l (0, xs @ Suc x # Suc y # anything) [Dec (Suc n) 2, Goto 0] 2 =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1513	(0, xs @ Suc x # y # anything)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1514	using h
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1515	by(simp add: abc_steps_l.simps numeral_2_eq_2 abc_step_l.simps abc_fetch.simps
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1516	abc_lm_v.simps abc_lm_s.simps nth_append list_update_append list_update.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1517	ultimately show "?case"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1518	apply(simp add: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1519	by(rule_tac x = "2 + stp" in exI, simp only: abc_steps_add, simp)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1520	qed
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1521	qed
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1522
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1523	lemma adjust_paras:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1524	"length xs = n \<Longrightarrow> {\<lambda>nl. nl = xs @ x # y # anything} [Inc n, Dec (Suc n) 3, Goto (Suc 0)]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1525	{\<lambda>nl. nl = xs @ Suc x # 0 # anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1526	using adjust_paras'[of xs n x y anything]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1527	by(simp add: abc_comp.simps abc_shift.simps numeral_2_eq_2 numeral_3_eq_3)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1528
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1529	lemma [simp]: "\<lbrakk>rec_ci g = (gap, gar, gft); \<forall>y<x. terminate g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])]);
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1530	length xs = n; Suc y\<le>x\<rbrakk> \<Longrightarrow> gar = Suc (Suc n)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1531	apply(erule_tac x = y in allE, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1532	apply(drule_tac param_pattern, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1533	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1534
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1535	lemma loop_back':
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1536	assumes h: "length A = length gap + 4" "length xs = n"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1537	and le: "y \<ge> x"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1538	shows "\<exists> stp. abc_steps_l (length A, xs @ m # (y - x) # x # anything) (A @ [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length gap + 4)]) stp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1539	= (length A, xs @ m # y # 0 # anything)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1540	using le
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1541	proof(induct x)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1542	case 0
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1543	thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1544	using h
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1545	by(rule_tac x = 0 in exI,
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1546	auto simp: abc_steps_l.simps abc_step_l.simps abc_fetch.simps nth_append abc_lm_s.simps abc_lm_v.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1547	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1548	case (Suc x)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1549	have "x \<le> y \<Longrightarrow> \<exists>stp. abc_steps_l (length A, xs @ m # (y - x) # x # anything) (A @ [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length gap + 4)]) stp =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1550	(length A, xs @ m # y # 0 # anything)" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1551	moreover have "Suc x \<le> y" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1552	moreover then have "\<exists> stp. abc_steps_l (length A, xs @ m # (y - Suc x) # Suc x # anything) (A @ [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length gap + 4)]) stp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1553	= (length A, xs @ m # (y - x) # x # anything)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1554	using h
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1555	apply(rule_tac x = 3 in exI)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1556	by(simp add: abc_steps_l.simps numeral_3_eq_3 abc_step_l.simps abc_fetch.simps nth_append abc_lm_v.simps abc_lm_s.simps
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1557	list_update_append list_update.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1558	ultimately show "?case"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1559	apply(auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1560	apply(rule_tac x = "stpa + stp" in exI)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1561	by(simp add: abc_steps_add)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1562	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1563
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1564
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1565	lemma loop_back:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1566	assumes h: "length A = length gap + 4" "length xs = n"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1567	shows "\<exists> stp. abc_steps_l (length A, xs @ m # 0 # x # anything) (A @ [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length gap + 4)]) stp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1568	= (0, xs @ m # x # 0 # anything)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1569	using loop_back'[of A gap xs n x x m anything] assms
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1570	apply(auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1571	apply(rule_tac x = "stp + 1" in exI)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1572	apply(simp only: abc_steps_add, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1573	apply(simp add: abc_steps_l.simps abc_step_l.simps abc_fetch.simps nth_append abc_lm_v.simps abc_lm_s.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1574	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1575
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1576	lemma rec_exec_pr_0_simps: "rec_exec (Pr n f g) (xs @ [0]) = rec_exec f xs"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1577	by(simp add: rec_exec.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1578
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1579	lemma rec_exec_pr_Suc_simps: "rec_exec (Pr n f g) (xs @ [Suc y])
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1580	= rec_exec g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])])"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1581	apply(induct y)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1582	apply(simp add: rec_exec.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1583	apply(simp add: rec_exec.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1584	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1585
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1586	lemma [simp]: "Suc (max (n + 3) (max fft gft) - Suc (Suc (Suc n))) = max (n + 3) (max fft gft) - Suc (Suc n)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1587	by arith
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1588
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1589	lemma pr_loop:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1590	assumes code: "code = ([Dec (max (n + 3) (max fft gft)) (length gap + 7)] [+] (gap [+] [Inc n, Dec (Suc n) 3, Goto (Suc 0)])) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1591	[Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length gap + 4)]"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1592	and len: "length xs = n"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1593	and g_ind: "\<forall> y<x. (\<forall>anything. {\<lambda>nl. nl = xs @ y # rec_exec (Pr n f g) (xs @ [y]) # 0 \<up> (gft - gar) @ anything} gap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1594	{\<lambda>nl. nl = xs @ y # rec_exec (Pr n f g) (xs @ [y]) # rec_exec g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])]) # 0 \<up> (gft - Suc gar) @ anything})"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1595	and compile_g: "rec_ci g = (gap, gar, gft)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1596	and termi_g: "\<forall> y<x. terminate g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])])"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1597	and ft: "ft = max (n + 3) (max fft gft)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1598	and less: "Suc y \<le> x"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1599	shows
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1600	"\<exists>stp. abc_steps_l (0, xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (ft - Suc (Suc n)) @ Suc y # anything)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1601	code stp = (0, xs @ (x - y) # rec_exec (Pr n f g) (xs @ [x - y]) # 0 \<up> (ft - Suc (Suc n)) @ y # anything)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1602	proof -
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1603	let ?A = "[Dec ft (length gap + 7)]"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1604	let ?B = "gap"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1605	let ?C = "[Inc n, Dec (Suc n) 3, Goto (Suc 0)]"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1606	let ?D = "[Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length gap + 4)]"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1607	have "\<exists> stp. abc_steps_l (0, xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (ft - Suc (Suc n)) @ Suc y # anything)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1608	((?A [+] (?B [+] ?C)) @ ?D) stp = (length (?A [+] (?B [+] ?C)),
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1609	xs @ (x - y) # 0 # rec_exec g (xs @ [x - Suc y, rec_exec (Pr n f g) (xs @ [x - Suc y])])
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1610	# 0 \<up> (ft - Suc (Suc (Suc n))) @ y # anything)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1611	proof -
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1612	have "\<exists> stp. abc_steps_l (0, xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (ft - Suc (Suc n)) @ Suc y # anything)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1613	((?A [+] (?B [+] ?C))) stp = (length (?A [+] (?B [+] ?C)), xs @ (x - y) # 0 #
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1614	rec_exec g (xs @ [x - Suc y, rec_exec (Pr n f g) (xs @ [x - Suc y])]) # 0 \<up> (ft - Suc (Suc (Suc n))) @ y # anything)"
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1615	proof -
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1616	have "{\<lambda> nl. nl = xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (ft - Suc (Suc n)) @ Suc y # anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1617	(?A [+] (?B [+] ?C))
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1618	{\<lambda> nl. nl = xs @ (x - y) # 0 #
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1619	rec_exec g (xs @ [x - Suc y, rec_exec (Pr n f g) (xs @ [x - Suc y])]) # 0 \<up> (ft - Suc (Suc (Suc n))) @ y # anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1620	proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1621	show "{\<lambda>nl. nl = xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (ft - Suc (Suc n)) @ Suc y # anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1622	[Dec ft (length gap + 7)]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1623	{\<lambda>nl. nl = xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (ft - Suc (Suc n)) @ y # anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1624	using ft len
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1625	by(simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1626	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1627	show
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1628	"{\<lambda>nl. nl = xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (ft - Suc (Suc n)) @ y # anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1629	?B [+] ?C
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1630	{\<lambda>nl. nl = xs @ (x - y) # 0 # rec_exec g (xs @ [x - Suc y, rec_exec (Pr n f g) (xs @ [x - Suc y])]) # 0 \<up> (ft - Suc (Suc (Suc n))) @ y # anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1631	proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1632	have a: "gar = Suc (Suc n)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1633	using compile_g termi_g len less
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1634	by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1635	have b: "gft > gar"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1636	using compile_g
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1637	by(erule_tac footprint_ge)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1638	show "{\<lambda>nl. nl = xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (ft - Suc (Suc n)) @ y # anything} gap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1639	{\<lambda>nl. nl = xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) #
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1640	rec_exec g (xs @ [x - Suc y, rec_exec (Pr n f g) (xs @ [x - Suc y])]) # 0 \<up> (ft - Suc (Suc (Suc n))) @ y # anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1641	proof -
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1642	have
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1643	"{\<lambda>nl. nl = xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (gft - gar) @ 0\<up>(ft - gft) @ y # anything} gap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1644	{\<lambda>nl. nl = xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) #
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1645	rec_exec g (xs @ [(x - Suc y), rec_exec (Pr n f g) (xs @ [x - Suc y])]) # 0 \<up> (gft - Suc gar) @ 0\<up>(ft - gft) @ y # anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1646	using g_ind less by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1647	thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1648	using a b ft
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1649	by(simp add: replicate_merge_anywhere numeral_3_eq_3)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1650	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1651	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1652	show "{\<lambda>nl. nl = xs @ (x - Suc y) #
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1653	rec_exec (Pr n f g) (xs @ [x - Suc y]) #
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1654	rec_exec g (xs @ [x - Suc y, rec_exec (Pr n f g) (xs @ [x - Suc y])]) # 0 \<up> (ft - Suc (Suc (Suc n))) @ y # anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1655	[Inc n, Dec (Suc n) 3, Goto (Suc 0)]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1656	{\<lambda>nl. nl = xs @ (x - y) # 0 # rec_exec g (xs @ [x - Suc y, rec_exec (Pr n f g)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1657	(xs @ [x - Suc y])]) # 0 \<up> (ft - Suc (Suc (Suc n))) @ y # anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1658	using len less
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1659	using adjust_paras[of xs n "x - Suc y" " rec_exec (Pr n f g) (xs @ [x - Suc y])"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1660	" rec_exec g (xs @ [x - Suc y, rec_exec (Pr n f g) (xs @ [x - Suc y])]) #
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1661	0 \<up> (ft - Suc (Suc (Suc n))) @ y # anything"]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1662	by(simp add: Suc_diff_Suc)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1663	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1664	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1665	thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1666	by(simp add: abc_Hoare_halt_def, auto, rule_tac x = na in exI, case_tac "abc_steps_l (0, xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) #
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1667	0 \<up> (ft - Suc (Suc n)) @ Suc y # anything)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1668	([Dec ft (length gap + 7)] [+] (gap [+] [Inc n, Dec (Suc n) 3, Goto (Suc 0)])) na", simp)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1669	qed
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1670	then obtain stpa where "abc_steps_l (0, xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (ft - Suc (Suc n)) @ Suc y # anything)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1671	((?A [+] (?B [+] ?C))) stpa = (length (?A [+] (?B [+] ?C)),
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1672	xs @ (x - y) # 0 # rec_exec g (xs @ [x - Suc y, rec_exec (Pr n f g) (xs @ [x - Suc y])])
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1673	# 0 \<up> (ft - Suc (Suc (Suc n))) @ y # anything)" ..
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1674	thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1675	by(erule_tac abc_append_frist_steps_halt_eq)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1676	qed
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1677	moreover have
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1678	"\<exists> stp. abc_steps_l (length (?A [+] (?B [+] ?C)),
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1679	xs @ (x - y) # 0 # rec_exec g (xs @ [x - Suc y, rec_exec (Pr n f g) (xs @ [x - Suc y])]) # 0 \<up> (ft - Suc (Suc (Suc n))) @ y # anything)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1680	((?A [+] (?B [+] ?C)) @ ?D) stp = (0, xs @ (x - y) # rec_exec g (xs @ [x - Suc y, rec_exec (Pr n f g) (xs @ [x - Suc y])]) #
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1681	0 # 0 \<up> (ft - Suc (Suc (Suc n))) @ y # anything)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1682	using len
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1683	by(rule_tac loop_back, simp_all)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1684	moreover have "rec_exec g (xs @ [x - Suc y, rec_exec (Pr n f g) (xs @ [x - Suc y])]) = rec_exec (Pr n f g) (xs @ [x - y])"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1685	using less
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1686	thm rec_exec.simps
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1687	apply(case_tac "x - y", simp_all add: rec_exec_pr_Suc_simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1688	by(subgoal_tac "nat = x - Suc y", simp, arith)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1689	ultimately show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1690	using code ft
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1691	by(auto, rule_tac x = "stp + stpa" in exI, simp add: abc_steps_add replicate_Suc_iff_anywhere del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1692	qed
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1693
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1694	lemma [simp]:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1695	"length xs = n \<Longrightarrow> abc_lm_s (xs @ x # rec_exec (Pr n f g) (xs @ [x]) # 0 \<up> (max (n + 3)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1696	(max fft gft) - Suc (Suc n)) @ 0 # anything) (max (n + 3) (max fft gft)) 0 =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1697	xs @ x # rec_exec (Pr n f g) (xs @ [x]) # 0 \<up> (max (n + 3) (max fft gft) - Suc n) @ anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1698	apply(simp add: abc_lm_s.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1699	using list_update_length[of "xs @ x # rec_exec (Pr n f g) (xs @ [x]) # 0 \<up> (max (n + 3) (max fft gft) - Suc (Suc n))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1700	0 anything 0]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1701	apply(auto simp: Suc_diff_Suc)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1702	apply(simp add: exp_suc[THEN sym] Suc_diff_Suc del: replicate_Suc)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1703	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1704
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1705	lemma [simp]:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1706	"(xs @ x # rec_exec (Pr (length xs) f g) (xs @ [x]) # 0 \<up> (max (length xs + 3)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1707	(max fft gft) - Suc (Suc (length xs))) @ 0 # anything) !
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1708	max (length xs + 3) (max fft gft) = 0"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1709	using nth_append_length[of "xs @ x # rec_exec (Pr (length xs) f g) (xs @ [x]) #
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1710	0 \<up> (max (length xs + 3) (max fft gft) - Suc (Suc (length xs)))" 0 anything]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1711	by(simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1712
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1713	lemma pr_loop_correct:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1714	assumes less: "y \<le> x"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1715	and len: "length xs = n"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1716	and compile_g: "rec_ci g = (gap, gar, gft)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1717	and termi_g: "\<forall> y<x. terminate g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])])"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1718	and g_ind: "\<forall> y<x. (\<forall>anything. {\<lambda>nl. nl = xs @ y # rec_exec (Pr n f g) (xs @ [y]) # 0 \<up> (gft - gar) @ anything} gap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1719	{\<lambda>nl. nl = xs @ y # rec_exec (Pr n f g) (xs @ [y]) # rec_exec g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])]) # 0 \<up> (gft - Suc gar) @ anything})"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1720	shows "{\<lambda>nl. nl = xs @ (x - y) # rec_exec (Pr n f g) (xs @ [x - y]) # 0 \<up> (max (n + 3) (max fft gft) - Suc (Suc n)) @ y # anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1721	([Dec (max (n + 3) (max fft gft)) (length gap + 7)] [+] (gap [+] [Inc n, Dec (Suc n) 3, Goto (Suc 0)])) @ [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length gap + 4)]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1722	{\<lambda>nl. nl = xs @ x # rec_exec (Pr n f g) (xs @ [x]) # 0 \<up> (max (n + 3) (max fft gft) - Suc n) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1723	using less
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1724	proof(induct y)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1725	case 0
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1726	thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1727	using len
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1728	apply(simp add: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1729	apply(rule_tac x = 1 in exI)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1730	by(auto simp: abc_steps_l.simps abc_step_l.simps abc_fetch.simps
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1731	nth_append abc_comp.simps abc_shift.simps, simp add: abc_lm_v.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1732	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1733	case (Suc y)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1734	let ?ft = "max (n + 3) (max fft gft)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1735	let ?C = "[Dec (max (n + 3) (max fft gft)) (length gap + 7)] [+] (gap [+]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1736	[Inc n, Dec (Suc n) 3, Goto (Suc 0)]) @ [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length gap + 4)]"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1737	have ind: "y \<le> x \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1738	{\<lambda>nl. nl = xs @ (x - y) # rec_exec (Pr n f g) (xs @ [x - y]) # 0 \<up> (?ft - Suc (Suc n)) @ y # anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1739	?C {\<lambda>nl. nl = xs @ x # rec_exec (Pr n f g) (xs @ [x]) # 0 \<up> (?ft - Suc n) @ anything}" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1740	have less: "Suc y \<le> x" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1741	have stp1:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1742	"\<exists> stp. abc_steps_l (0, xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (?ft - Suc (Suc n)) @ Suc y # anything)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1743	?C stp = (0, xs @ (x - y) # rec_exec (Pr n f g) (xs @ [x - y]) # 0 \<up> (?ft - Suc (Suc n)) @ y # anything)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1744	using assms less
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1745	by(rule_tac pr_loop, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1746	then obtain stp1 where a:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1747	"abc_steps_l (0, xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (?ft - Suc (Suc n)) @ Suc y # anything)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1748	?C stp1 = (0, xs @ (x - y) # rec_exec (Pr n f g) (xs @ [x - y]) # 0 \<up> (?ft - Suc (Suc n)) @ y # anything)" ..
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1749	moreover have
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1750	"\<exists> stp. abc_steps_l (0, xs @ (x - y) # rec_exec (Pr n f g) (xs @ [x - y]) # 0 \<up> (?ft - Suc (Suc n)) @ y # anything)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1751	?C stp = (length ?C, xs @ x # rec_exec (Pr n f g) (xs @ [x]) # 0 \<up> (?ft - Suc n) @ anything)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1752	using ind less
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1753	by(auto simp: abc_Hoare_halt_def, case_tac "abc_steps_l (0, xs @ (x - y) # rec_exec (Pr n f g)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1754	(xs @ [x - y]) # 0 \<up> (?ft - Suc (Suc n)) @ y # anything) ?C na", rule_tac x = na in exI, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1755	then obtain stp2 where b:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1756	"abc_steps_l (0, xs @ (x - y) # rec_exec (Pr n f g) (xs @ [x - y]) # 0 \<up> (?ft - Suc (Suc n)) @ y # anything)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1757	?C stp2 = (length ?C, xs @ x # rec_exec (Pr n f g) (xs @ [x]) # 0 \<up> (?ft - Suc n) @ anything)" ..
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1758	from a b show "?case"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1759	by(simp add: abc_Hoare_halt_def, rule_tac x = "stp1 + stp2" in exI, simp add: abc_steps_add)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1760	qed
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1761
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1762	lemma compile_pr_correct':
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1763	assumes termi_g: "\<forall> y<x. terminate g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])])"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1764	and g_ind:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1765	"\<forall> y<x. (\<forall>anything. {\<lambda>nl. nl = xs @ y # rec_exec (Pr n f g) (xs @ [y]) # 0 \<up> (gft - gar) @ anything} gap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1766	{\<lambda>nl. nl = xs @ y # rec_exec (Pr n f g) (xs @ [y]) # rec_exec g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])]) # 0 \<up> (gft - Suc gar) @ anything})"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1767	and termi_f: "terminate f xs"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1768	and f_ind: "\<And> anything. {\<lambda>nl. nl = xs @ 0 \<up> (fft - far) @ anything} fap {\<lambda>nl. nl = xs @ rec_exec f xs # 0 \<up> (fft - Suc far) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1769	and len: "length xs = n"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1770	and compile1: "rec_ci f = (fap, far, fft)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1771	and compile2: "rec_ci g = (gap, gar, gft)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1772	shows
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1773	"{\<lambda>nl. nl = xs @ x # 0 \<up> (max (n + 3) (max fft gft) - n) @ anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1774	mv_box n (max (n + 3) (max fft gft)) [+]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1775	(fap [+] (mv_box n (Suc n) [+]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1776	([Dec (max (n + 3) (max fft gft)) (length gap + 7)] [+] (gap [+] [Inc n, Dec (Suc n) 3, Goto (Suc 0)]) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1777	[Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length gap + 4)])))
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1778	{\<lambda>nl. nl = xs @ x # rec_exec (Pr n f g) (xs @ [x]) # 0 \<up> (max (n + 3) (max fft gft) - Suc n) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1779	proof -
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1780	let ?ft = "max (n+3) (max fft gft)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1781	let ?A = "mv_box n ?ft"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1782	let ?B = "fap"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1783	let ?C = "mv_box n (Suc n)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1784	let ?D = "[Dec ?ft (length gap + 7)]"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1785	let ?E = "gap [+] [Inc n, Dec (Suc n) 3, Goto (Suc 0)]"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1786	let ?F = "[Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length gap + 4)]"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1787	let ?P = "\<lambda>nl. nl = xs @ x # 0 \<up> (?ft - n) @ anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1788	let ?S = "\<lambda>nl. nl = xs @ x # rec_exec (Pr n f g) (xs @ [x]) # 0 \<up> (?ft - Suc n) @ anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1789	let ?Q1 = "\<lambda>nl. nl = xs @ 0 \<up> (?ft - n) @ x # anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1790	show "{?P} (?A [+] (?B [+] (?C [+] (?D [+] ?E @ ?F)))) {?S}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1791	proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1792	show "{?P} ?A {?Q1}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1793	using len by simp
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1794	next
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1795	let ?Q2 = "\<lambda>nl. nl = xs @ rec_exec f xs # 0 \<up> (?ft - Suc n) @ x # anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1796	have a: "?ft \<ge> fft"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1797	by arith
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1798	have b: "far = n"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1799	using compile1 termi_f len
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1800	by(drule_tac param_pattern, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1801	have c: "fft > far"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1802	using compile1
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1803	by(simp add: footprint_ge)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1804	show "{?Q1} (?B [+] (?C [+] (?D [+] ?E @ ?F))) {?S}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1805	proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1806	have "{\<lambda>nl. nl = xs @ 0 \<up> (fft - far) @ 0\<up>(?ft - fft) @ x # anything} fap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1807	{\<lambda>nl. nl = xs @ rec_exec f xs # 0 \<up> (fft - Suc far) @ 0\<up>(?ft - fft) @ x # anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1808	by(rule_tac f_ind)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1809	moreover have "fft - far + ?ft - fft = ?ft - far"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1810	using a b c by arith
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1811	moreover have "fft - Suc n + ?ft - fft = ?ft - Suc n"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1812	using a b c by arith
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1813	ultimately show "{?Q1} ?B {?Q2}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1814	using b
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1815	by(simp add: replicate_merge_anywhere)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1816	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1817	let ?Q3 = "\<lambda> nl. nl = xs @ 0 # rec_exec f xs # 0\<up>(?ft - Suc (Suc n)) @ x # anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1818	show "{?Q2} (?C [+] (?D [+] ?E @ ?F)) {?S}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1819	proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1820	show "{?Q2} (?C) {?Q3}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1821	using mv_box_correct[of n "Suc n" "xs @ rec_exec f xs # 0 \<up> (max (n + 3) (max fft gft) - Suc n) @ x # anything"]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1822	using len
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1823	by(auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1824	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1825	show "{?Q3} (?D [+] ?E @ ?F) {?S}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1826	using pr_loop_correct[of x x xs n g gap gar gft f fft anything] assms
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1827	by(simp add: rec_exec_pr_0_simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1828	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1829	qed
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1830	qed
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1831	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1832
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1833	lemma compile_pr_correct:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1834	assumes g_ind: "\<forall>y<x. terminate g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])]) \<and>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1835	(\<forall>x xa xb. rec_ci g = (x, xa, xb) \<longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1836	(\<forall>xc. {\<lambda>nl. nl = xs @ y # rec_exec (Pr n f g) (xs @ [y]) # 0 \<up> (xb - xa) @ xc} x
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1837	{\<lambda>nl. nl = xs @ y # rec_exec (Pr n f g) (xs @ [y]) # rec_exec g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])]) # 0 \<up> (xb - Suc xa) @ xc}))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1838	and termi_f: "terminate f xs"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1839	and f_ind:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1840	"\<And>ap arity fp anything.
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1841	rec_ci f = (ap, arity, fp) \<Longrightarrow> {\<lambda>nl. nl = xs @ 0 \<up> (fp - arity) @ anything} ap {\<lambda>nl. nl = xs @ rec_exec f xs # 0 \<up> (fp - Suc arity) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1842	and len: "length xs = n"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1843	and compile: "rec_ci (Pr n f g) = (ap, arity, fp)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1844	shows "{\<lambda>nl. nl = xs @ x # 0 \<up> (fp - arity) @ anything} ap {\<lambda>nl. nl = xs @ x # rec_exec (Pr n f g) (xs @ [x]) # 0 \<up> (fp - Suc arity) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1845	proof(case_tac "rec_ci f", case_tac "rec_ci g")
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1846	fix fap far fft gap gar gft
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1847	assume h: "rec_ci f = (fap, far, fft)" "rec_ci g = (gap, gar, gft)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1848	have g:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1849	"\<forall>y<x. (terminate g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])]) \<and>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1850	(\<forall>anything. {\<lambda>nl. nl = xs @ y # rec_exec (Pr n f g) (xs @ [y]) # 0 \<up> (gft - gar) @ anything} gap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1851	{\<lambda>nl. nl = xs @ y # rec_exec (Pr n f g) (xs @ [y]) # rec_exec g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])]) # 0 \<up> (gft - Suc gar) @ anything}))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1852	using g_ind h
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1853	by(auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1854	hence termi_g: "\<forall> y<x. terminate g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])])"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1855	by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1856	from g have g_newind:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1857	"\<forall> y<x. (\<forall>anything. {\<lambda>nl. nl = xs @ y # rec_exec (Pr n f g) (xs @ [y]) # 0 \<up> (gft - gar) @ anything} gap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1858	{\<lambda>nl. nl = xs @ y # rec_exec (Pr n f g) (xs @ [y]) # rec_exec g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])]) # 0 \<up> (gft - Suc gar) @ anything})"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1859	by auto
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1860	have f_newind: "\<And> anything. {\<lambda>nl. nl = xs @ 0 \<up> (fft - far) @ anything} fap {\<lambda>nl. nl = xs @ rec_exec f xs # 0 \<up> (fft - Suc far) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1861	using h
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1862	by(rule_tac f_ind, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1863	show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1864	using termi_f termi_g h compile
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1865	apply(simp add: rec_ci.simps abc_comp_commute, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1866	using g_newind f_newind len
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1867	by(rule_tac compile_pr_correct', simp_all)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1868	qed
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	1869
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1870	fun mn_ind_inv ::
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1871	"nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat list \<Rightarrow> nat list \<Rightarrow> bool"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1872	where
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1873	"mn_ind_inv (as, lm') ss x rsx suf_lm lm =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1874	(if as = ss then lm' = lm @ x # rsx # suf_lm
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1875	else if as = ss + 1 then
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1876	\<exists>y. (lm' = lm @ x # y # suf_lm) \<and> y \<le> rsx
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1877	else if as = ss + 2 then
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1878	\<exists>y. (lm' = lm @ x # y # suf_lm) \<and> y \<le> rsx
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1879	else if as = ss + 3 then lm' = lm @ x # 0 # suf_lm
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1880	else if as = ss + 4 then lm' = lm @ Suc x # 0 # suf_lm
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1881	else if as = 0 then lm' = lm @ Suc x # 0 # suf_lm
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1882	else False
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1883	)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1884
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1885	fun mn_stage1 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1886	where
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1887	"mn_stage1 (as, lm) ss n =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1888	(if as = 0 then 0
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1889	else if as = ss + 4 then 1
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1890	else if as = ss + 3 then 2
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1891	else if as = ss + 2 \<or> as = ss + 1 then 3
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1892	else if as = ss then 4
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1893	else 0
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1894	)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1895
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1896	fun mn_stage2 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1897	where
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1898	"mn_stage2 (as, lm) ss n =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1899	(if as = ss + 1 \<or> as = ss + 2 then (lm ! (Suc n))
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1900	else 0)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1901
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1902	fun mn_stage3 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1903	where
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1904	"mn_stage3 (as, lm) ss n = (if as = ss + 2 then 1 else 0)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1905
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1906
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1907	fun mn_measure :: "((nat \<times> nat list) \<times> nat \<times> nat) \<Rightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1908	(nat \<times> nat \<times> nat)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1909	where
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1910	"mn_measure ((as, lm), ss, n) =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1911	(mn_stage1 (as, lm) ss n, mn_stage2 (as, lm) ss n,
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1912	mn_stage3 (as, lm) ss n)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1913
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1914	definition mn_LE :: "(((nat \<times> nat list) \<times> nat \<times> nat) \<times>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1915	((nat \<times> nat list) \<times> nat \<times> nat)) set"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1916	where "mn_LE \<equiv> (inv_image lex_triple mn_measure)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1917
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1918	lemma wf_mn_le[intro]: "wf mn_LE"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1919	by(auto intro:wf_inv_image wf_lex_triple simp: mn_LE_def)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1920
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1921	declare mn_ind_inv.simps[simp del]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1922
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1923	lemma [simp]:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1924	"0 < rsx \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1925	\<exists>y. (xs @ x # rsx # anything)[Suc (length xs) := rsx - Suc 0] = xs @ x # y # anything \<and> y \<le> rsx"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1926	apply(rule_tac x = "rsx - 1" in exI)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1927	apply(simp add: list_update_append list_update.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1928	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1929
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1930	lemma [simp]:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1931	"\<lbrakk>y \<le> rsx; 0 < y\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1932	\<Longrightarrow> \<exists>ya. (xs @ x # y # anything)[Suc (length xs) := y - Suc 0] = xs @ x # ya # anything \<and> ya \<le> rsx"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1933	apply(rule_tac x = "y - 1" in exI)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1934	apply(simp add: list_update_append list_update.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1935	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1936
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1937	lemma abc_comp_null[simp]: "(A [+] B = []) = (A = [] \<and> B = [])"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1938	by(auto simp: abc_comp.simps abc_shift.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1939
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1940	lemma rec_ci_not_null[simp]: "(rec_ci f \<noteq> ([], a, b))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1941	apply(case_tac f, auto simp: rec_ci_z_def rec_ci_s_def rec_ci.simps addition.simps rec_ci_id.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1942	apply(case_tac "rec_ci recf", auto simp: mv_box.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1943	apply(case_tac "rec_ci recf1", case_tac "rec_ci recf2", simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1944	apply(case_tac "rec_ci recf", simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1945	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1946
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1947	lemma mn_correct:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1948	assumes compile: "rec_ci rf = (fap, far, fft)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1949	and ge: "0 < rsx"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1950	and len: "length xs = arity"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1951	and B: "B = [Dec (Suc arity) (length fap + 5), Dec (Suc arity) (length fap + 3), Goto (Suc (length fap)), Inc arity, Goto 0]"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1952	and f: "f = (\<lambda> stp. (abc_steps_l (length fap, xs @ x # rsx # anything) (fap @ B) stp, (length fap), arity)) "
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1953	and P: "P =(\<lambda> ((as, lm), ss, arity). as = 0)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1954	and Q: "Q = (\<lambda> ((as, lm), ss, arity). mn_ind_inv (as, lm) (length fap) x rsx anything xs)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1955	shows "\<exists> stp. P (f stp) \<and> Q (f stp)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1956	proof(rule_tac halt_lemma2)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1957	show "wf mn_LE"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1958	using wf_mn_le by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1959	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1960	show "Q (f 0)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1961	by(auto simp: Q f abc_steps_l.simps mn_ind_inv.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1962	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1963	have "fap \<noteq> []"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1964	using compile by auto
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1965	thus "\<not> P (f 0)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1966	by(auto simp: f P abc_steps_l.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1967	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1968	have "fap \<noteq> []"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1969	using compile by auto
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1970	then have "\<And> stp. \<lbrakk>\<not> P (f stp); Q (f stp)\<rbrakk> \<Longrightarrow> Q (f (Suc stp)) \<and> (f (Suc stp), f stp) \<in> mn_LE"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1971	using ge len
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1972	apply(case_tac "(abc_steps_l (length fap, xs @ x # rsx # anything) (fap @ B) stp)")
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1973	apply(simp add: abc_step_red2 B f P Q)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1974	apply(auto split:if_splits simp add:abc_steps_l.simps mn_ind_inv.simps abc_steps_zero B abc_fetch.simps nth_append)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1975	by(auto simp: mn_LE_def lex_triple_def lex_pair_def
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1976	abc_step_l.simps abc_steps_l.simps mn_ind_inv.simps
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1977	abc_lm_v.simps abc_lm_s.simps nth_append abc_fetch.simps
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1978	split: if_splits)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1979	thus "\<forall>stp. \<not> P (f stp) \<and> Q (f stp) \<longrightarrow> Q (f (Suc stp)) \<and> (f (Suc stp), f stp) \<in> mn_LE"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1980	by(auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1981	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1982
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1983	lemma abc_Hoare_haltE:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1984	"{\<lambda> nl. nl = lm1} p {\<lambda> nl. nl = lm2}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1985	\<Longrightarrow> \<exists> stp. abc_steps_l (0, lm1) p stp = (length p, lm2)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1986	apply(auto simp: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1987	apply(rule_tac x = n in exI)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1988	apply(case_tac "abc_steps_l (0, lm1) p n", auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1989	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1990
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1991	lemma mn_loop:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1992	assumes B: "B = [Dec (Suc arity) (length fap + 5), Dec (Suc arity) (length fap + 3), Goto (Suc (length fap)), Inc arity, Goto 0]"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1993	and ft: "ft = max (Suc arity) fft"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1994	and len: "length xs = arity"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1995	and far: "far = Suc arity"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1996	and ind: " (\<forall>xc. ({\<lambda>nl. nl = xs @ x # 0 \<up> (fft - far) @ xc} fap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1997	{\<lambda>nl. nl = xs @ x # rec_exec f (xs @ [x]) # 0 \<up> (fft - Suc far) @ xc}))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1998	and exec_less: "rec_exec f (xs @ [x]) > 0"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	1999	and compile: "rec_ci f = (fap, far, fft)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2000	shows "\<exists> stp > 0. abc_steps_l (0, xs @ x # 0 \<up> (ft - Suc arity) @ anything) (fap @ B) stp =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2001	(0, xs @ Suc x # 0 \<up> (ft - Suc arity) @ anything)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2002	proof -
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2003	have "\<exists> stp. abc_steps_l (0, xs @ x # 0 \<up> (ft - Suc arity) @ anything) (fap @ B) stp =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2004	(length fap, xs @ x # rec_exec f (xs @ [x]) # 0 \<up> (ft - Suc (Suc arity)) @ anything)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2005	proof -
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2006	have "\<exists> stp. abc_steps_l (0, xs @ x # 0 \<up> (ft - Suc arity) @ anything) fap stp =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2007	(length fap, xs @ x # rec_exec f (xs @ [x]) # 0 \<up> (ft - Suc (Suc arity)) @ anything)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2008	proof -
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2009	have "{\<lambda>nl. nl = xs @ x # 0 \<up> (fft - far) @ 0\<up>(ft - fft) @ anything} fap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2010	{\<lambda>nl. nl = xs @ x # rec_exec f (xs @ [x]) # 0 \<up> (fft - Suc far) @ 0\<up>(ft - fft) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2011	using ind by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2012	moreover have "fft > far"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2013	using compile
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2014	by(erule_tac footprint_ge)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2015	ultimately show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2016	using ft far
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2017	apply(drule_tac abc_Hoare_haltE)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2018	by(simp add: replicate_merge_anywhere max_absorb2)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2019	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2020	then obtain stp where "abc_steps_l (0, xs @ x # 0 \<up> (ft - Suc arity) @ anything) fap stp =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2021	(length fap, xs @ x # rec_exec f (xs @ [x]) # 0 \<up> (ft - Suc (Suc arity)) @ anything)" ..
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2022	thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2023	by(erule_tac abc_append_frist_steps_halt_eq)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2024	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2025	moreover have
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2026	"\<exists> stp > 0. abc_steps_l (length fap, xs @ x # rec_exec f (xs @ [x]) # 0 \<up> (ft - Suc (Suc arity)) @ anything) (fap @ B) stp =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2027	(0, xs @ Suc x # 0 # 0 \<up> (ft - Suc (Suc arity)) @ anything)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2028	using mn_correct[of f fap far fft "rec_exec f (xs @ [x])" xs arity B
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2029	"(\<lambda>stp. (abc_steps_l (length fap, xs @ x # rec_exec f (xs @ [x]) # 0 \<up> (ft - Suc (Suc arity)) @ anything) (fap @ B) stp, length fap, arity))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2030	x "0 \<up> (ft - Suc (Suc arity)) @ anything" "(\<lambda>((as, lm), ss, arity). as = 0)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2031	"(\<lambda>((as, lm), ss, aritya). mn_ind_inv (as, lm) (length fap) x (rec_exec f (xs @ [x])) (0 \<up> (ft - Suc (Suc arity)) @ anything) xs) "]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2032	B compile exec_less len
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2033	apply(subgoal_tac "fap \<noteq> []", auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2034	apply(rule_tac x = stp in exI, auto simp: mn_ind_inv.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2035	by(case_tac "stp = 0", simp_all add: abc_steps_l.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2036	moreover have "fft > far"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2037	using compile
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2038	by(erule_tac footprint_ge)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2039	ultimately show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2040	using ft far
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2041	apply(auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2042	by(rule_tac x = "stp + stpa" in exI,
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2043	simp add: abc_steps_add replicate_Suc[THEN sym] diff_Suc_Suc del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2044	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2045
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2046	lemma mn_loop_correct':
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2047	assumes B: "B = [Dec (Suc arity) (length fap + 5), Dec (Suc arity) (length fap + 3), Goto (Suc (length fap)), Inc arity, Goto 0]"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2048	and ft: "ft = max (Suc arity) fft"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2049	and len: "length xs = arity"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2050	and ind_all: "\<forall>i\<le>x. (\<forall>xc. ({\<lambda>nl. nl = xs @ i # 0 \<up> (fft - far) @ xc} fap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2051	{\<lambda>nl. nl = xs @ i # rec_exec f (xs @ [i]) # 0 \<up> (fft - Suc far) @ xc}))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2052	and exec_ge: "\<forall> i\<le>x. rec_exec f (xs @ [i]) > 0"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2053	and compile: "rec_ci f = (fap, far, fft)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2054	and far: "far = Suc arity"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2055	shows "\<exists> stp > x. abc_steps_l (0, xs @ 0 # 0 \<up> (ft - Suc arity) @ anything) (fap @ B) stp =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2056	(0, xs @ Suc x # 0 \<up> (ft - Suc arity) @ anything)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2057	using ind_all exec_ge
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2058	proof(induct x)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2059	case 0
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2060	thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2061	using assms
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2062	by(rule_tac mn_loop, simp_all)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2063	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2064	case (Suc x)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2065	have ind': "\<lbrakk>\<forall>i\<le>x. \<forall>xc. {\<lambda>nl. nl = xs @ i # 0 \<up> (fft - far) @ xc} fap {\<lambda>nl. nl = xs @ i # rec_exec f (xs @ [i]) # 0 \<up> (fft - Suc far) @ xc};
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2066	\<forall>i\<le>x. 0 < rec_exec f (xs @ [i])\<rbrakk> \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2067	\<exists>stp > x. abc_steps_l (0, xs @ 0 # 0 \<up> (ft - Suc arity) @ anything) (fap @ B) stp = (0, xs @ Suc x # 0 \<up> (ft - Suc arity) @ anything)" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2068	have exec_ge: "\<forall>i\<le>Suc x. 0 < rec_exec f (xs @ [i])" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2069	have ind_all: "\<forall>i\<le>Suc x. \<forall>xc. {\<lambda>nl. nl = xs @ i # 0 \<up> (fft - far) @ xc} fap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2070	{\<lambda>nl. nl = xs @ i # rec_exec f (xs @ [i]) # 0 \<up> (fft - Suc far) @ xc}" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2071	have ind: "\<exists>stp > x. abc_steps_l (0, xs @ 0 # 0 \<up> (ft - Suc arity) @ anything) (fap @ B) stp =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2072	(0, xs @ Suc x # 0 \<up> (ft - Suc arity) @ anything)" using ind' exec_ge ind_all by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2073	have stp: "\<exists> stp > 0. abc_steps_l (0, xs @ Suc x # 0 \<up> (ft - Suc arity) @ anything) (fap @ B) stp =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2074	(0, xs @ Suc (Suc x) # 0 \<up> (ft - Suc arity) @ anything)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2075	using ind_all exec_ge B ft len far compile
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2076	by(rule_tac mn_loop, simp_all)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2077	from ind stp show "?case"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2078	apply(auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2079	by(rule_tac x = "stp + stpa" in exI, simp add: abc_steps_add)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2080	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2081
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2082	lemma mn_loop_correct:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2083	assumes B: "B = [Dec (Suc arity) (length fap + 5), Dec (Suc arity) (length fap + 3), Goto (Suc (length fap)), Inc arity, Goto 0]"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2084	and ft: "ft = max (Suc arity) fft"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2085	and len: "length xs = arity"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2086	and ind_all: "\<forall>i\<le>x. (\<forall>xc. ({\<lambda>nl. nl = xs @ i # 0 \<up> (fft - far) @ xc} fap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2087	{\<lambda>nl. nl = xs @ i # rec_exec f (xs @ [i]) # 0 \<up> (fft - Suc far) @ xc}))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2088	and exec_ge: "\<forall> i\<le>x. rec_exec f (xs @ [i]) > 0"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2089	and compile: "rec_ci f = (fap, far, fft)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2090	and far: "far = Suc arity"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2091	shows "\<exists> stp. abc_steps_l (0, xs @ 0 # 0 \<up> (ft - Suc arity) @ anything) (fap @ B) stp =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2092	(0, xs @ Suc x # 0 \<up> (ft - Suc arity) @ anything)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2093	proof -
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2094	have "\<exists>stp>x. abc_steps_l (0, xs @ 0 # 0 \<up> (ft - Suc arity) @ anything) (fap @ B) stp = (0, xs @ Suc x # 0 \<up> (ft - Suc arity) @ anything)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2095	using assms
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2096	by(rule_tac mn_loop_correct', simp_all)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2097	thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2098	by(auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2099	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2100
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2101	lemma compile_mn_correct':
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2102	assumes B: "B = [Dec (Suc arity) (length fap + 5), Dec (Suc arity) (length fap + 3), Goto (Suc (length fap)), Inc arity, Goto 0]"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2103	and ft: "ft = max (Suc arity) fft"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2104	and len: "length xs = arity"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2105	and termi_f: "terminate f (xs @ [r])"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2106	and f_ind: "\<And>anything. {\<lambda>nl. nl = xs @ r # 0 \<up> (fft - far) @ anything} fap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2107	{\<lambda>nl. nl = xs @ r # 0 # 0 \<up> (fft - Suc far) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2108	and ind_all: "\<forall>i < r. (\<forall>xc. ({\<lambda>nl. nl = xs @ i # 0 \<up> (fft - far) @ xc} fap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2109	{\<lambda>nl. nl = xs @ i # rec_exec f (xs @ [i]) # 0 \<up> (fft - Suc far) @ xc}))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2110	and exec_less: "\<forall> i<r. rec_exec f (xs @ [i]) > 0"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2111	and exec: "rec_exec f (xs @ [r]) = 0"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2112	and compile: "rec_ci f = (fap, far, fft)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2113	shows "{\<lambda>nl. nl = xs @ 0 \<up> (max (Suc arity) fft - arity) @ anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2114	fap @ B
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2115	{\<lambda>nl. nl = xs @ rec_exec (Mn arity f) xs # 0 \<up> (max (Suc arity) fft - Suc arity) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2116	proof -
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2117	have a: "far = Suc arity"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2118	using len compile termi_f
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2119	by(drule_tac param_pattern, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2120	have b: "fft > far"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2121	using compile
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2122	by(erule_tac footprint_ge)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2123	have "\<exists> stp. abc_steps_l (0, xs @ 0 # 0 \<up> (ft - Suc arity) @ anything) (fap @ B) stp =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2124	(0, xs @ r # 0 \<up> (ft - Suc arity) @ anything)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2125	using assms a
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2126	apply(case_tac r, rule_tac x = 0 in exI, simp add: abc_steps_l.simps, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2127	by(rule_tac mn_loop_correct, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2128	moreover have
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2129	"\<exists> stp. abc_steps_l (0, xs @ r # 0 \<up> (ft - Suc arity) @ anything) (fap @ B) stp =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2130	(length fap, xs @ r # rec_exec f (xs @ [r]) # 0 \<up> (ft - Suc (Suc arity)) @ anything)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2131	proof -
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2132	have "\<exists> stp. abc_steps_l (0, xs @ r # 0 \<up> (ft - Suc arity) @ anything) fap stp =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2133	(length fap, xs @ r # rec_exec f (xs @ [r]) # 0 \<up> (ft - Suc (Suc arity)) @ anything)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2134	proof -
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2135	have "{\<lambda>nl. nl = xs @ r # 0 \<up> (fft - far) @ 0\<up>(ft - fft) @ anything} fap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2136	{\<lambda>nl. nl = xs @ r # rec_exec f (xs @ [r]) # 0 \<up> (fft - Suc far) @ 0\<up>(ft - fft) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2137	using f_ind exec by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2138	thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2139	using ft a b
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2140	apply(drule_tac abc_Hoare_haltE)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2141	by(simp add: replicate_merge_anywhere max_absorb2)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2142	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2143	then obtain stp where "abc_steps_l (0, xs @ r # 0 \<up> (ft - Suc arity) @ anything) fap stp =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2144	(length fap, xs @ r # rec_exec f (xs @ [r]) # 0 \<up> (ft - Suc (Suc arity)) @ anything)" ..
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2145	thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2146	by(erule_tac abc_append_frist_steps_halt_eq)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2147	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2148	moreover have
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2149	"\<exists> stp. abc_steps_l (length fap, xs @ r # rec_exec f (xs @ [r]) # 0 \<up> (ft - Suc (Suc arity)) @ anything) (fap @ B) stp =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2150	(length fap + 5, xs @ r # rec_exec f (xs @ [r]) # 0 \<up> (ft - Suc (Suc arity)) @ anything)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2151	using ft a b len B exec
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2152	apply(rule_tac x = 1 in exI, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2153	by(auto simp: abc_steps_l.simps B abc_step_l.simps
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2154	abc_fetch.simps nth_append max_absorb2 abc_lm_v.simps abc_lm_s.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2155	moreover have "rec_exec (Mn (length xs) f) xs = r"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2156	using exec exec_less
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2157	apply(auto simp: rec_exec.simps Least_def)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2158	thm the_equality
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2159	apply(rule_tac the_equality, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2160	apply(metis exec_less less_not_refl3 linorder_not_less)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2161	by (metis le_neq_implies_less less_not_refl3)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2162	ultimately show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2163	using ft a b len B exec
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2164	apply(auto simp: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2165	apply(rule_tac x = "stp + stpa + stpb" in exI)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2166	by(simp add: abc_steps_add replicate_Suc_iff_anywhere max_absorb2 Suc_diff_Suc del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2167	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2168
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2169	lemma compile_mn_correct:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2170	assumes len: "length xs = n"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2171	and termi_f: "terminate f (xs @ [r])"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2172	and f_ind: "\<And>ap arity fp anything. rec_ci f = (ap, arity, fp) \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2173	{\<lambda>nl. nl = xs @ r # 0 \<up> (fp - arity) @ anything} ap {\<lambda>nl. nl = xs @ r # 0 # 0 \<up> (fp - Suc arity) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2174	and exec: "rec_exec f (xs @ [r]) = 0"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2175	and ind_all:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2176	"\<forall>i<r. terminate f (xs @ [i]) \<and>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2177	(\<forall>x xa xb. rec_ci f = (x, xa, xb) \<longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2178	(\<forall>xc. {\<lambda>nl. nl = xs @ i # 0 \<up> (xb - xa) @ xc} x {\<lambda>nl. nl = xs @ i # rec_exec f (xs @ [i]) # 0 \<up> (xb - Suc xa) @ xc})) \<and>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2179	0 < rec_exec f (xs @ [i])"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2180	and compile: "rec_ci (Mn n f) = (ap, arity, fp)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2181	shows "{\<lambda>nl. nl = xs @ 0 \<up> (fp - arity) @ anything} ap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2182	{\<lambda>nl. nl = xs @ rec_exec (Mn n f) xs # 0 \<up> (fp - Suc arity) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2183	proof(case_tac "rec_ci f")
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2184	fix fap far fft
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2185	assume h: "rec_ci f = (fap, far, fft)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2186	hence f_newind:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2187	"\<And>anything. {\<lambda>nl. nl = xs @ r # 0 \<up> (fft - far) @ anything} fap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2188	{\<lambda>nl. nl = xs @ r # 0 # 0 \<up> (fft - Suc far) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2189	by(rule_tac f_ind, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2190	have newind_all:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2191	"\<forall>i < r. (\<forall>xc. ({\<lambda>nl. nl = xs @ i # 0 \<up> (fft - far) @ xc} fap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2192	{\<lambda>nl. nl = xs @ i # rec_exec f (xs @ [i]) # 0 \<up> (fft - Suc far) @ xc}))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2193	using ind_all h
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2194	by(auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2195	have all_less: "\<forall> i<r. rec_exec f (xs @ [i]) > 0"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2196	using ind_all by auto
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2197	show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2198	using h compile f_newind newind_all all_less len termi_f exec
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2199	apply(auto simp: rec_ci.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2200	by(rule_tac compile_mn_correct', auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2201	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2202
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2203	lemma recursive_compile_correct:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2204	"\<lbrakk>terminate recf args; rec_ci recf = (ap, arity, fp)\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2205	\<Longrightarrow> {\<lambda> nl. nl = args @ 0\<up>(fp - arity) @ anything} ap
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2206	{\<lambda> nl. nl = args@ rec_exec recf args # 0\<up>(fp - Suc arity) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2207	apply(induct arbitrary: ap arity fp anything r rule: terminate.induct)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2208	apply(simp_all add: compile_s_correct compile_z_correct compile_id_correct
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2209	compile_cn_correct compile_pr_correct compile_mn_correct)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2210	done
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2211
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2212	definition dummy_abc :: "nat \<Rightarrow> abc_inst list"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2213	where
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2214	"dummy_abc k = [Inc k, Dec k 0, Goto 3]"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2215
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2216	definition abc_list_crsp:: "nat list \<Rightarrow> nat list \<Rightarrow> bool"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2217	where
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2218	"abc_list_crsp xs ys = (\<exists> n. xs = ys @ 0\<up>n \<or> ys = xs @ 0\<up>n)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2219
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2220	lemma abc_list_crsp_simp1[intro]: "abc_list_crsp (lm @ 0\<up>m) lm"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2221	by(auto simp: abc_list_crsp_def)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2222
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2223
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2224	lemma abc_list_crsp_lm_v:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2225	"abc_list_crsp lma lmb \<Longrightarrow> abc_lm_v lma n = abc_lm_v lmb n"
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2226	by(auto simp: abc_list_crsp_def abc_lm_v.simps
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2227	nth_append)
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2228
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2229
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2230	lemma abc_list_crsp_elim:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2231	"\<lbrakk>abc_list_crsp lma lmb; \<exists> n. lma = lmb @ 0\<up>n \<or> lmb = lma @ 0\<up>n \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2232	by(auto simp: abc_list_crsp_def)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2233
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2234	lemma [simp]:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2235	"\<lbrakk>abc_list_crsp lma lmb; m < length lma; m < length lmb\<rbrakk> \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2236	abc_list_crsp (lma[m := n]) (lmb[m := n])"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2237	by(auto simp: abc_list_crsp_def list_update_append)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2238
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2239	lemma [simp]:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2240	"\<lbrakk>abc_list_crsp lma lmb; m < length lma; \<not> m < length lmb\<rbrakk> \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2241	abc_list_crsp (lma[m := n]) (lmb @ 0 \<up> (m - length lmb) @ [n])"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2242	apply(auto simp: abc_list_crsp_def list_update_append)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2243	apply(rule_tac x = "na + length lmb - Suc m" in exI)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2244	apply(rule_tac disjI1)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2245	apply(simp add: upd_conv_take_nth_drop min_absorb1)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2246	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2247
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2248	lemma [simp]:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2249	"\<lbrakk>abc_list_crsp lma lmb; \<not> m < length lma; m < length lmb\<rbrakk> \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2250	abc_list_crsp (lma @ 0 \<up> (m - length lma) @ [n]) (lmb[m := n])"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2251	apply(auto simp: abc_list_crsp_def list_update_append)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2252	apply(rule_tac x = "na + length lma - Suc m" in exI)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2253	apply(rule_tac disjI2)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2254	apply(simp add: upd_conv_take_nth_drop min_absorb1)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2255	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2256
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2257	lemma [simp]: "\<lbrakk>abc_list_crsp lma lmb; \<not> m < length lma; \<not> m < length lmb\<rbrakk> \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2258	abc_list_crsp (lma @ 0 \<up> (m - length lma) @ [n]) (lmb @ 0 \<up> (m - length lmb) @ [n])"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2259	by(auto simp: abc_list_crsp_def list_update_append replicate_merge_anywhere)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2260
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2261	lemma abc_list_crsp_lm_s:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2262	"abc_list_crsp lma lmb \<Longrightarrow>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2263	abc_list_crsp (abc_lm_s lma m n) (abc_lm_s lmb m n)"
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2264	by(auto simp: abc_lm_s.simps)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2265
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2266	lemma abc_list_crsp_step:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2267	"\<lbrakk>abc_list_crsp lma lmb; abc_step_l (aa, lma) i = (a, lma');
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2268	abc_step_l (aa, lmb) i = (a', lmb')\<rbrakk>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2269	\<Longrightarrow> a' = a \<and> abc_list_crsp lma' lmb'"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2270	apply(case_tac i, auto simp: abc_step_l.simps
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2271	abc_list_crsp_lm_s abc_list_crsp_lm_v Let_def
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2272	split: abc_inst.splits if_splits)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2273	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2274
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2275	lemma abc_list_crsp_steps:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2276	"\<lbrakk>abc_steps_l (0, lm @ 0\<up>m) aprog stp = (a, lm'); aprog \<noteq> []\<rbrakk>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2277	\<Longrightarrow> \<exists> lma. abc_steps_l (0, lm) aprog stp = (a, lma) \<and>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2278	abc_list_crsp lm' lma"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2279	apply(induct stp arbitrary: a lm', simp add: abc_steps_l.simps, auto)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2280	apply(case_tac "abc_steps_l (0, lm @ 0\<up>m) aprog stp",
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2281	simp add: abc_step_red)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2282	proof -
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2283	fix stp a lm' aa b
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2284	assume ind:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2285	"\<And>a lm'. aa = a \<and> b = lm' \<Longrightarrow>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2286	\<exists>lma. abc_steps_l (0, lm) aprog stp = (a, lma) \<and>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2287	abc_list_crsp lm' lma"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2288	and h: "abc_steps_l (0, lm @ 0\<up>m) aprog (Suc stp) = (a, lm')"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2289	"abc_steps_l (0, lm @ 0\<up>m) aprog stp = (aa, b)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2290	"aprog \<noteq> []"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2291	hence g1: "abc_steps_l (0, lm @ 0\<up>m) aprog (Suc stp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2292	= abc_step_l (aa, b) (abc_fetch aa aprog)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2293	apply(rule_tac abc_step_red, simp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2294	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2295	have "\<exists>lma. abc_steps_l (0, lm) aprog stp = (aa, lma) \<and>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2296	abc_list_crsp b lma"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2297	apply(rule_tac ind, simp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2298	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2299	from this obtain lma where g2:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2300	"abc_steps_l (0, lm) aprog stp = (aa, lma) \<and>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2301	abc_list_crsp b lma" ..
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2302	hence g3: "abc_steps_l (0, lm) aprog (Suc stp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2303	= abc_step_l (aa, lma) (abc_fetch aa aprog)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2304	apply(rule_tac abc_step_red, simp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2305	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2306	show "\<exists>lma. abc_steps_l (0, lm) aprog (Suc stp) = (a, lma) \<and> abc_list_crsp lm' lma"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2307	using g1 g2 g3 h
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2308	apply(auto)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2309	apply(case_tac "abc_step_l (aa, b) (abc_fetch aa aprog)",
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2310	case_tac "abc_step_l (aa, lma) (abc_fetch aa aprog)", simp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2311	apply(rule_tac abc_list_crsp_step, auto)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2312	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2313	qed
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2314
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2315	lemma list_crsp_simp2: "abc_list_crsp (lm1 @ 0\<up>n) lm2 \<Longrightarrow> abc_list_crsp lm1 lm2"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2316	proof(induct n)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2317	case 0
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2318	thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2319	by(auto simp: abc_list_crsp_def)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2320	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2321	case (Suc n)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2322	have ind: "abc_list_crsp (lm1 @ 0 \<up> n) lm2 \<Longrightarrow> abc_list_crsp lm1 lm2" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2323	have h: "abc_list_crsp (lm1 @ 0 \<up> Suc n) lm2" by fact
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2324	then have "abc_list_crsp (lm1 @ 0 \<up> n) lm2"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2325	apply(auto simp: exp_suc abc_list_crsp_def del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2326	apply(case_tac n, simp_all add: exp_suc replicate_Suc[THEN sym] del: replicate_Suc, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2327	apply(rule_tac x = 1 in exI, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2328	by(rule_tac x = "Suc n" in exI, simp, simp add: exp_suc replicate_Suc[THEN sym] del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2329	thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2330	using ind
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2331	by auto
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2332	qed
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2333
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2334	lemma recursive_compile_correct_norm':
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2335	"\<lbrakk>rec_ci f = (ap, arity, ft);
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2336	terminate f args\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2337	\<Longrightarrow> \<exists> stp rl. (abc_steps_l (0, args) ap stp) = (length ap, rl) \<and> abc_list_crsp (args @ [rec_exec f args]) rl"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2338	using recursive_compile_correct[of f args ap arity ft "[]"]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2339	apply(auto simp: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2340	apply(rule_tac x = n in exI)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2341	apply(case_tac "abc_steps_l (0, args @ 0 \<up> (ft - arity)) ap n", auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2342	apply(drule_tac abc_list_crsp_steps, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2343	apply(rule_tac list_crsp_simp2, auto)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2344	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2345
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2346	lemma [simp]:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2347	assumes a: "args @ [rec_exec f args] = lm @ 0 \<up> n"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2348	and b: "length args < length lm"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2349	shows "\<exists>m. lm = args @ rec_exec f args # 0 \<up> m"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2350	using assms
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2351	apply(case_tac n, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2352	apply(rule_tac x = 0 in exI, simp)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2353	apply(drule_tac length_equal, simp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2354	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2355
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2356	lemma [simp]:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2357	"\<lbrakk>args @ [rec_exec f args] = lm @ 0 \<up> n; \<not> length args < length lm\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2358	\<Longrightarrow> \<exists>m. (lm @ 0 \<up> (length args - length lm) @ [Suc 0])[length args := 0] =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2359	args @ rec_exec f args # 0 \<up> m"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2360	apply(case_tac n, simp_all add: exp_suc list_update_append list_update.simps del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2361	apply(subgoal_tac "length args = Suc (length lm)", simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2362	apply(rule_tac x = "Suc (Suc 0)" in exI, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2363	apply(drule_tac length_equal, simp, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2364	done
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2365
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2366	lemma compile_append_dummy_correct:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2367	assumes compile: "rec_ci f = (ap, ary, fp)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2368	and termi: "terminate f args"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2369	shows "{\<lambda> nl. nl = args} (ap [+] dummy_abc (length args)) {\<lambda> nl. (\<exists> m. nl = args @ rec_exec f args # 0\<up>m)}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2370	proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2371	show "{\<lambda>nl. nl = args} ap {\<lambda> nl. abc_list_crsp (args @ [rec_exec f args]) nl}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2372	using compile termi recursive_compile_correct_norm'[of f ap ary fp args]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2373	apply(auto simp: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2374	by(rule_tac x = stp in exI, simp)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2375	next
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2376	show "{abc_list_crsp (args @ [rec_exec f args])} dummy_abc (length args)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2377	{\<lambda>nl. \<exists>m. nl = args @ rec_exec f args # 0 \<up> m}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2378	apply(auto simp: dummy_abc_def abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2379	apply(rule_tac x = 3 in exI)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2380	by(auto simp: abc_steps_l.simps abc_list_crsp_def abc_step_l.simps numeral_3_eq_3 abc_fetch.simps
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2381	abc_lm_v.simps nth_append abc_lm_s.simps)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2382	qed
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2383
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2384	lemma cn_merge_gs_split:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2385	"\<lbrakk>i < length gs; rec_ci (gs!i) = (ga, gb, gc)\<rbrakk> \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2386	cn_merge_gs (map rec_ci gs) p = cn_merge_gs (map rec_ci (take i gs)) p [+] (ga [+]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2387	mv_box gb (p + i)) [+] cn_merge_gs (map rec_ci (drop (Suc i) gs)) (p + Suc i)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2388	apply(induct i arbitrary: gs p, case_tac gs, simp, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2389	apply(case_tac gs, simp, case_tac "rec_ci a",
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2390	simp add: abc_comp_commute[THEN sym])
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2391	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2392
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2393	lemma cn_unhalt_case:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2394	assumes compile1: "rec_ci (Cn n f gs) = (ap, ar, ft) \<and> length args = ar"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2395	and g: "i < length gs"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2396	and compile2: "rec_ci (gs!i) = (gap, gar, gft) \<and> gar = length args"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2397	and g_unhalt: "\<And> anything. {\<lambda> nl. nl = args @ 0\<up>(gft - gar) @ anything} gap \<up>"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2398	and g_ind: "\<And> apj arj ftj j anything. \<lbrakk>j < i; rec_ci (gs!j) = (apj, arj, ftj)\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2399	\<Longrightarrow> {\<lambda> nl. nl = args @ 0\<up>(ftj - arj) @ anything} apj {\<lambda> nl. nl = args @ rec_exec (gs!j) args # 0\<up>(ftj - Suc arj) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2400	and all_termi: "\<forall> j<i. terminate (gs!j) args"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2401	shows "{\<lambda> nl. nl = args @ 0\<up>(ft - ar) @ anything} ap \<up>"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2402	using compile1
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2403	apply(case_tac "rec_ci f", auto simp: rec_ci.simps abc_comp_commute)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2404	proof(rule_tac abc_Hoare_plus_unhalt1)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2405	fix fap far fft
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2406	let ?ft = "max (Suc (length args)) (Max (insert fft ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2407	let ?Q = "\<lambda>nl. nl = args @ 0\<up> (?ft - length args) @ map (\<lambda>i. rec_exec i args) (take i gs) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2408	0\<up>(length gs - i) @ 0\<up> Suc (length args) @ anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2409	have "cn_merge_gs (map rec_ci gs) ?ft =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2410	cn_merge_gs (map rec_ci (take i gs)) ?ft [+] (gap [+]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2411	mv_box gar (?ft + i)) [+] cn_merge_gs (map rec_ci (drop (Suc i) gs)) (?ft + Suc i)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2412	using g compile2 cn_merge_gs_split by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2413	thus "{\<lambda>nl. nl = args @ 0 # 0 \<up> (?ft + length gs) @ anything} (cn_merge_gs (map rec_ci gs) ?ft) \<up>"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2414	proof(simp, rule_tac abc_Hoare_plus_unhalt1, rule_tac abc_Hoare_plus_unhalt2,
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2415	rule_tac abc_Hoare_plus_unhalt1)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2416	let ?Q_tmp = "\<lambda>nl. nl = args @ 0\<up> (gft - gar) @ 0\<up>(?ft - (length args) - (gft -gar)) @ map (\<lambda>i. rec_exec i args) (take i gs) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2417	0\<up>(length gs - i) @ 0\<up> Suc (length args) @ anything"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2418	have a: "{?Q_tmp} gap \<up>"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2419	using g_unhalt[of "0 \<up> (?ft - (length args) - (gft - gar)) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2420	map (\<lambda>i. rec_exec i args) (take i gs) @ 0 \<up> (length gs - i) @ 0 \<up> Suc (length args) @ anything"]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2421	by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2422	moreover have "?ft \<ge> gft"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2423	using g compile2
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2424	apply(rule_tac min_max.le_supI2, rule_tac Max_ge, simp, rule_tac insertI2)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2425	apply(rule_tac x = "rec_ci (gs ! i)" in image_eqI, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2426	by(rule_tac x = "gs!i" in image_eqI, simp, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2427	then have b:"?Q_tmp = ?Q"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2428	using compile2
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2429	apply(rule_tac arg_cong)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2430	by(simp add: replicate_merge_anywhere)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2431	thus "{?Q} gap \<up>"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2432	using a by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2433	next
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2434	show "{\<lambda>nl. nl = args @ 0 # 0 \<up> (?ft + length gs) @ anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2435	cn_merge_gs (map rec_ci (take i gs)) ?ft
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2436	{\<lambda>nl. nl = args @ 0 \<up> (?ft - length args) @
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2437	map (\<lambda>i. rec_exec i args) (take i gs) @ 0 \<up> (length gs - i) @ 0 \<up> Suc (length args) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2438	using all_termi
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2439	apply(rule_tac compile_cn_gs_correct', auto simp: set_conv_nth)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2440	by(drule_tac apj = x and arj = xa and ftj = xb and j = ia and anything = xc in g_ind, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2441	qed
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2442	qed
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2443
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2444
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2445
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2446	lemma mn_unhalt_case':
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2447	assumes compile: "rec_ci f = (a, b, c)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2448	and all_termi: "\<forall>i. terminate f (args @ [i]) \<and> 0 < rec_exec f (args @ [i])"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2449	and B: "B = [Dec (Suc (length args)) (length a + 5), Dec (Suc (length args)) (length a + 3),
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2450	Goto (Suc (length a)), Inc (length args), Goto 0]"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2451	shows "{\<lambda>nl. nl = args @ 0 \<up> (max (Suc (length args)) c - length args) @ anything}
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2452	a @ B \<up>"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2453	proof(rule_tac abc_Hoare_unhaltI, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2454	fix n
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2455	have a: "b = Suc (length args)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2456	using all_termi compile
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2457	apply(erule_tac x = 0 in allE)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2458	by(auto, drule_tac param_pattern,auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2459	moreover have b: "c > b"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2460	using compile by(elim footprint_ge)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2461	ultimately have c: "max (Suc (length args)) c = c" by arith
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2462	have "\<exists> stp > n. abc_steps_l (0, args @ 0 # 0\<up>(c - Suc (length args)) @ anything) (a @ B) stp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2463	= (0, args @ Suc n # 0\<up>(c - Suc (length args)) @ anything)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2464	using assms a b c
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2465	proof(rule_tac mn_loop_correct', auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2466	fix i xc
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2467	show "{\<lambda>nl. nl = args @ i # 0 \<up> (c - Suc (length args)) @ xc} a
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2468	{\<lambda>nl. nl = args @ i # rec_exec f (args @ [i]) # 0 \<up> (c - Suc (Suc (length args))) @ xc}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2469	using all_termi recursive_compile_correct[of f "args @ [i]" a b c xc] compile a
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2470	by(simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2471	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2472	then obtain stp where d: "stp > n \<and> abc_steps_l (0, args @ 0 # 0\<up>(c - Suc (length args)) @ anything) (a @ B) stp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2473	= (0, args @ Suc n # 0\<up>(c - Suc (length args)) @ anything)" ..
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2474	then obtain d where e: "stp = n + Suc d"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2475	by (metis add_Suc_right less_iff_Suc_add)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2476	obtain s nl where f: "abc_steps_l (0, args @ 0 # 0\<up>(c - Suc (length args)) @ anything) (a @ B) n = (s, nl)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2477	by (metis prod.exhaust)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2478	have g: "s < length (a @ B)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2479	using d e f
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2480	apply(rule_tac classical, simp only: abc_steps_add)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2481	by(simp add: halt_steps2 leI)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2482	from f g show "abc_notfinal (abc_steps_l (0, args @ 0 \<up>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2483	(max (Suc (length args)) c - length args) @ anything) (a @ B) n) (a @ B)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2484	using c b a
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2485	by(simp add: replicate_Suc_iff_anywhere Suc_diff_Suc del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2486	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2487
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2488	lemma mn_unhalt_case:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2489	assumes compile: "rec_ci (Mn n f) = (ap, ar, ft) \<and> length args = ar"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2490	and all_term: "\<forall> i. terminate f (args @ [i]) \<and> rec_exec f (args @ [i]) > 0"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2491	shows "{\<lambda> nl. nl = args @ 0\<up>(ft - ar) @ anything} ap \<up> "
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2492	using assms
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2493	apply(case_tac "rec_ci f", auto simp: rec_ci.simps abc_comp_commute)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2494	by(rule_tac mn_unhalt_case', simp_all)
129 c3832c4963c4 updated recursive Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 126 diff changeset	2495
c3832c4963c4 updated recursive Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 126 diff changeset	2496	fun tm_of_rec :: "recf \<Rightarrow> instr list"
c3832c4963c4 updated recursive Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 126 diff changeset	2497	where "tm_of_rec recf = (let (ap, k, fp) = rec_ci recf in
c3832c4963c4 updated recursive Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 126 diff changeset	2498	let tp = tm_of (ap [+] dummy_abc k) in
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2499	tp @ (shift (mopup k) (length tp div 2)))"
129 c3832c4963c4 updated recursive Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 126 diff changeset	2500
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2501	lemma recursive_compile_to_tm_correct1:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2502	assumes compile: "rec_ci recf = (ap, ary, fp)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2503	and termi: " terminate recf args"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2504	and tp: "tp = tm_of (ap [+] dummy_abc (length args))"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2505	shows "\<exists> stp m l. steps0 (Suc 0, Bk # Bk # ires, <args> @ Bk\<up>rn)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2506	(tp @ shift (mopup (length args)) (length tp div 2)) stp = (0, Bk\<up>m @ Bk # Bk # ires, Oc\<up>Suc (rec_exec recf args) @ Bk\<up>l)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2507	proof -
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2508	have "{\<lambda>nl. nl = args} ap [+] dummy_abc (length args) {\<lambda>nl. \<exists>m. nl = args @ rec_exec recf args # 0 \<up> m}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2509	using compile termi compile
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2510	by(rule_tac compile_append_dummy_correct, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2511	then obtain stp m where h: "abc_steps_l (0, args) (ap [+] dummy_abc (length args)) stp =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2512	(length (ap [+] dummy_abc (length args)), args @ rec_exec recf args # 0\<up>m) "
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2513	apply(simp add: abc_Hoare_halt_def, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2514	by(case_tac "abc_steps_l (0, args) (ap [+] dummy_abc (length args)) n", auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2515	thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2516	using assms tp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2517	by(rule_tac lm = args and stp = stp and am = "args @ rec_exec recf args # 0 \<up> m"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2518	in compile_correct_halt, auto simp: crsp.simps start_of.simps length_abc_comp abc_lm_v.simps)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2519	qed
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2520
126 0b302c0b449a updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 70 diff changeset	2521	lemma recursive_compile_to_tm_correct2:
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2522	assumes compile: "rec_ci recf = (ap, ary, fp)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2523	and termi: " terminate recf args"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2524	shows "\<exists> stp m l. steps0 (Suc 0, [Bk, Bk], <args>) (tm_of_rec recf) stp =
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2525	(0, Bk\<up>Suc (Suc m), Oc\<up>Suc (rec_exec recf args) @ Bk\<up>l)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2526	using recursive_compile_to_tm_correct1[of recf ap ary fp args "tm_of (ap [+] dummy_abc (length args))" "[]" 0]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2527	assms param_pattern[of recf args ap ary fp]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2528	by(simp add: exp_suc replicate_Suc[THEN sym] del: replicate_Suc tm_of_rec_def)
126 0b302c0b449a updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 70 diff changeset	2529
129 c3832c4963c4 updated recursive Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 126 diff changeset	2530	lemma recursive_compile_to_tm_correct3:
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2531	assumes compile: "rec_ci recf = (ap, ary, fp)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2532	and termi: "terminate recf args"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2533	shows "{\<lambda> (l, r). l = [Bk, Bk] \<and> r = <args>} (tm_of_rec recf)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2534	{\<lambda> (l, r). \<exists> m i. l = Bk\<up>(Suc (Suc m)) \<and> r = Oc\<up>Suc (rec_exec recf args) @ Bk \<up> i}"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2535	using recursive_compile_to_tm_correct2[of recf ap ary fp args] assms
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2536	apply(simp add: Hoare_halt_def, auto)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2537	apply(rule_tac x = stp in exI, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2538	done
129 c3832c4963c4 updated recursive Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 126 diff changeset	2539
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2540	lemma [simp]:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2541	"list_all (\<lambda>(acn, s). s \<le> Suc (Suc (Suc (Suc (Suc (Suc (2 * n))))))) xs \<Longrightarrow>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2542	list_all (\<lambda>(acn, s). s \<le> Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc (2 * n))))))))) xs"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2543	apply(induct xs, simp, simp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2544	apply(case_tac a, simp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2545	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2546
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2547	lemma shift_append: "shift (xs @ ys) n = shift xs n @ shift ys n"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2548	apply(simp add: shift.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2549	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2550
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2551	lemma [simp]: "length (shift (mopup n) ss) = 4 * n + 12"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2552	apply(auto simp: mopup.simps shift_append mopup_b_def)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2553	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2554
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2555	lemma length_tm_even[intro]: "length (tm_of ap) mod 2 = 0"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2556	apply(simp add: tm_of.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2557	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2558
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2559	lemma [simp]: "k < length ap \<Longrightarrow> tms_of ap ! k =
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2560	ci (layout_of ap) (start_of (layout_of ap) k) (ap ! k)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2561	apply(simp add: tms_of.simps tpairs_of.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2562	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2563
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2564	lemma start_of_suc_inc:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2565	"\<lbrakk>k < length ap; ap ! k = Inc n\<rbrakk> \<Longrightarrow> start_of (layout_of ap) (Suc k) =
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2566	start_of (layout_of ap) k + 2 * n + 9"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2567	apply(rule_tac start_of_Suc1, auto simp: abc_fetch.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2568	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2569
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2570	lemma start_of_suc_dec:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2571	"\<lbrakk>k < length ap; ap ! k = (Dec n e)\<rbrakk> \<Longrightarrow> start_of (layout_of ap) (Suc k) =
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2572	start_of (layout_of ap) k + 2 * n + 16"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2573	apply(rule_tac start_of_Suc2, auto simp: abc_fetch.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2574	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2575
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2576	lemma inc_state_all_le:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2577	"\<lbrakk>k < length ap; ap ! k = Inc n;
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2578	(a, b) \<in> set (shift (shift tinc_b (2 * n))
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2579	(start_of (layout_of ap) k - Suc 0))\<rbrakk>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2580	\<Longrightarrow> b \<le> start_of (layout_of ap) (length ap)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2581	apply(subgoal_tac "b \<le> start_of (layout_of ap) (Suc k)")
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2582	apply(subgoal_tac "start_of (layout_of ap) (Suc k) \<le> start_of (layout_of ap) (length ap) ")
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2583	apply(arith)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2584	apply(case_tac "Suc k = length ap", simp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2585	apply(rule_tac start_of_less, simp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2586	apply(auto simp: tinc_b_def shift.simps start_of_suc_inc length_of.simps startof_not0)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2587	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2588
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2589	lemma findnth_le[elim]:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2590	"(a, b) \<in> set (shift (findnth n) (start_of (layout_of ap) k - Suc 0))
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2591	\<Longrightarrow> b \<le> Suc (start_of (layout_of ap) k + 2 * n)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2592	apply(induct n, simp add: findnth.simps shift.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2593	apply(simp add: findnth.simps shift_append, auto)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2594	apply(auto simp: shift.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2595	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2596
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2597	lemma findnth_state_all_le1:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2598	"\<lbrakk>k < length ap; ap ! k = Inc n;
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2599	(a, b) \<in>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2600	set (shift (findnth n) (start_of (layout_of ap) k - Suc 0))\<rbrakk>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2601	\<Longrightarrow> b \<le> start_of (layout_of ap) (length ap)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2602	apply(subgoal_tac "b \<le> start_of (layout_of ap) (Suc k)")
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2603	apply(subgoal_tac "start_of (layout_of ap) (Suc k) \<le> start_of (layout_of ap) (length ap) ")
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2604	apply(arith)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2605	apply(case_tac "Suc k = length ap", simp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2606	apply(rule_tac start_of_less, simp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2607	apply(subgoal_tac "b \<le> start_of (layout_of ap) k + 2*n + 1 \<and>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2608	start_of (layout_of ap) k + 2*n + 1 \<le> start_of (layout_of ap) (Suc k)", auto)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2609	apply(auto simp: tinc_b_def shift.simps length_of.simps startof_not0 start_of_suc_inc)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2610	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2611
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2612	lemma start_of_eq: "length ap < as \<Longrightarrow> start_of (layout_of ap) as = start_of (layout_of ap) (length ap)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2613	apply(induct as, simp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2614	apply(case_tac "length ap < as", simp add: start_of.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2615	apply(subgoal_tac "as = length ap")
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2616	apply(simp add: start_of.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2617	apply arith
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2618	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2619
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2620	lemma start_of_all_le: "start_of (layout_of ap) as \<le> start_of (layout_of ap) (length ap)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2621	apply(subgoal_tac "as > length ap \<or> as = length ap \<or> as < length ap",
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2622	auto simp: start_of_eq start_of_less)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2623	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2624
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2625	lemma findnth_state_all_le2:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2626	"\<lbrakk>k < length ap;
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2627	ap ! k = Dec n e;
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2628	(a, b) \<in> set (shift (findnth n) (start_of (layout_of ap) k - Suc 0))\<rbrakk>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2629	\<Longrightarrow> b \<le> start_of (layout_of ap) (length ap)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2630	apply(subgoal_tac "b \<le> start_of (layout_of ap) k + 2*n + 1 \<and>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2631	start_of (layout_of ap) k + 2*n + 1 \<le> start_of (layout_of ap) (Suc k) \<and>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2632	start_of (layout_of ap) (Suc k) \<le> start_of (layout_of ap) (length ap)", auto)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2633	apply(subgoal_tac "start_of (layout_of ap) (Suc k) =
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2634	start_of (layout_of ap) k + 2*n + 16", simp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2635	apply(simp add: start_of_suc_dec)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2636	apply(rule_tac start_of_all_le)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2637	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2638
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2639	lemma dec_state_all_le[simp]:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2640	"\<lbrakk>k < length ap; ap ! k = Dec n e;
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2641	(a, b) \<in> set (shift (shift tdec_b (2 * n))
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2642	(start_of (layout_of ap) k - Suc 0))\<rbrakk>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2643	\<Longrightarrow> b \<le> start_of (layout_of ap) (length ap)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2644	apply(subgoal_tac "2*n + start_of (layout_of ap) k + 16 \<le> start_of (layout_of ap) (length ap) \<and> start_of (layout_of ap) k > 0")
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2645	prefer 2
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2646	apply(subgoal_tac "start_of (layout_of ap) (Suc k) = start_of (layout_of ap) k + 2*n + 16
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2647	\<and> start_of (layout_of ap) (Suc k) \<le> start_of (layout_of ap) (length ap)")
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2648	apply(simp add: startof_not0, rule_tac conjI)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2649	apply(simp add: start_of_suc_dec)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2650	apply(rule_tac start_of_all_le)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2651	apply(auto simp: tdec_b_def shift.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2652	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2653
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2654	lemma tms_any_less:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2655	"\<lbrakk>k < length ap; (a, b) \<in> set (tms_of ap ! k)\<rbrakk> \<Longrightarrow>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2656	b \<le> start_of (layout_of ap) (length ap)"
190 f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0 Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 172 diff changeset	2657	apply(case_tac "ap!k", auto simp: tms_of.simps tpairs_of.simps ci.simps shift_append adjust.simps)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2658	apply(erule_tac findnth_state_all_le1, simp_all)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2659	apply(erule_tac inc_state_all_le, simp_all)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2660	apply(erule_tac findnth_state_all_le2, simp_all)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2661	apply(rule_tac start_of_all_le)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2662	apply(rule_tac dec_state_all_le, simp_all)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2663	apply(rule_tac start_of_all_le)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2664	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2665
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2666	lemma concat_in: "i < length (concat xs) \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2667	\<exists>k < length xs. concat xs ! i \<in> set (xs ! k)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2668	apply(induct xs rule: rev_induct, simp, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2669	apply(case_tac "i < length (concat xs)", simp)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2670	apply(erule_tac exE, rule_tac x = k in exI)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2671	apply(simp add: nth_append)
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2672	apply(rule_tac x = "length xs" in exI, simp)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2673	apply(simp add: nth_append)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2674	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2675
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2676	lemma [simp]: "length (tms_of ap) = length ap"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2677	apply(simp add: tms_of.simps tpairs_of.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2678	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2679
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2680	declare length_concat[simp]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2681
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2682	lemma in_tms: "i < length (tm_of ap) \<Longrightarrow> \<exists> k < length ap. (tm_of ap ! i) \<in> set (tms_of ap ! k)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2683	apply(simp only: tm_of.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2684	using concat_in[of i "tms_of ap"]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2685	apply(auto)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2686	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2687
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2688	lemma all_le_start_of: "list_all (\<lambda>(acn, s).
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2689	s \<le> start_of (layout_of ap) (length ap)) (tm_of ap)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2690	apply(simp only: list_all_length)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2691	apply(rule_tac allI, rule_tac impI)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2692	apply(drule_tac in_tms, auto elim: tms_any_less)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2693	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2694
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2695	lemma length_ci:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2696	"\<lbrakk>k < length ap; length (ci ly y (ap ! k)) = 2 * qa\<rbrakk>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2697	\<Longrightarrow> layout_of ap ! k = qa"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2698	apply(case_tac "ap ! k")
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2699	apply(auto simp: layout_of.simps ci.simps
190 f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0 Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 172 diff changeset	2700	length_of.simps tinc_b_def tdec_b_def length_findnth adjust.simps)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2701	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2702
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2703	lemma [intro]: "length (ci ly y i) mod 2 = 0"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2704	apply(case_tac i, auto simp: ci.simps length_findnth
190 f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0 Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 172 diff changeset	2705	tinc_b_def adjust.simps tdec_b_def)
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2706	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2707
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2708	lemma [intro]: "listsum (map (length \<circ> (\<lambda>(x, y). ci ly x y)) zs) mod 2 = 0"
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2709	apply(induct zs rule: rev_induct, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2710	apply(case_tac x, simp)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2711	apply(subgoal_tac "length (ci ly a b) mod 2 = 0")
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2712	apply(auto)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2713	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2714
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2715	lemma zip_pre:
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2716	"(length ys) \<le> length ap \<Longrightarrow>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2717	zip ys ap = zip ys (take (length ys) (ap::'a list))"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2718	proof(induct ys arbitrary: ap, simp, case_tac ap, simp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2719	fix a ys ap aa list
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2720	assume ind: "\<And>(ap::'a list). length ys \<le> length ap \<Longrightarrow>
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2721	zip ys ap = zip ys (take (length ys) ap)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2722	and h: "length (a # ys) \<le> length ap" "(ap::'a list) = aa # (list::'a list)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2723	from h show "zip (a # ys) ap = zip (a # ys) (take (length (a # ys)) ap)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2724	using ind[of list]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2725	apply(simp)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2726	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2727	qed
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2728
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2729	lemma length_start_of_tm: "start_of (layout_of ap) (length ap) = Suc (length (tm_of ap) div 2)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2730	using tpa_states[of "tm_of ap" "length ap" ap]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2731	apply(simp add: tm_of.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2732	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2733
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2734	lemma [elim]: "list_all (\<lambda>(acn, s). s \<le> Suc q) xs
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2735	\<Longrightarrow> list_all (\<lambda>(acn, s). s \<le> q + (2 * n + 6)) xs"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2736	apply(simp add: list_all_length)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2737	apply(auto)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2738	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2739
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2740	lemma [simp]: "length mopup_b = 12"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2741	apply(simp add: mopup_b_def)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2742	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2743
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2744	lemma mp_up_all_le: "list_all (\<lambda>(acn, s). s \<le> q + (2 * n + 6))
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2745	[(R, Suc (Suc (2 * n + q))), (R, Suc (2 * n + q)),
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2746	(L, 5 + 2 * n + q), (W0, Suc (Suc (Suc (2 * n + q)))), (R, 4 + 2 * n + q),
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2747	(W0, Suc (Suc (Suc (2 * n + q)))), (R, Suc (Suc (2 * n + q))),
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2748	(W0, Suc (Suc (Suc (2 * n + q)))), (L, 5 + 2 * n + q),
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2749	(L, 6 + 2 * n + q), (R, 0), (L, 6 + 2 * n + q)]"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2750	apply(auto)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2751	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2752
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2753	lemma [simp]: "(a, b) \<in> set (mopup_a n) \<Longrightarrow> b \<le> 2 * n + 6"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2754	apply(induct n, auto simp: mopup_a.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2755	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2756
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2757	lemma [simp]: "(a, b) \<in> set (shift (mopup n) (listsum (layout_of ap)))
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2758	\<Longrightarrow> b \<le> (2 * listsum (layout_of ap) + length (mopup n)) div 2"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2759	apply(auto simp: mopup.simps shift_append shift.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2760	apply(auto simp: mopup_a.simps mopup_b_def)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2761	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2762
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2763	lemma [intro]: " 2 \<le> 2 * listsum (layout_of ap) + length (mopup n)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2764	apply(simp add: mopup.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2765	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2766
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2767	lemma [intro]: " (2 * listsum (layout_of ap) + length (mopup n)) mod 2 = 0"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2768	apply(auto simp: mopup.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2769	apply arith
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2770	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2771
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2772	lemma [simp]: "b \<le> Suc x
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2773	\<Longrightarrow> b \<le> (2 * x + length (mopup n)) div 2"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2774	apply(auto simp: mopup.simps)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2775	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2776
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2777	lemma wf_tm_from_abacus:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2778	"tp = tm_of ap \<Longrightarrow>
70 2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2779	tm_wf (tp @ shift( mopup n) (length tp div 2), 0)"
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2780	using length_start_of_tm[of ap] all_le_start_of[of ap]
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2781	apply(auto simp: tm_wf.simps List.list_all_iff)
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2782	done
2363eb91d9fd updated Christian Urban <christian dot urban at kcl dot ac dot uk> parents: diff changeset	2783
229 d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2784	lemma wf_tm_from_recf:
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2785	assumes compile: "tp = tm_of_rec recf"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2786	shows "tm_wf0 tp"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2787	proof -
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2788	obtain a b c where "rec_ci recf = (a, b, c)"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2789	by (metis prod_cases3)
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2790	thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2791	using compile
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2792	using wf_tm_from_abacus[of "tm_of (a [+] dummy_abc b)" "(a [+] dummy_abc b)" b]
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2793	by simp
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2794	qed
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2795
d8e6f0798e23 much simplified version of Recursive.thy Christian Urban <christian dot urban at kcl dot ac dot uk> parents: 204 diff changeset	2796	end

author	Christian Urban <christian dot urban at kcl dot ac dot uk>
	Wed, 27 Mar 2013 09:47:02 +0000
changeset 229	d8e6f0798e23
parent 204	e55c8e5da49f
child 230	49dcc0b9b0b3
permissions	-rwxr-xr-x