author | Christian Urban <christian dot urban at kcl dot ac dot uk> |
Fri, 08 Mar 2013 11:10:45 +0000 | |
changeset 219 | a3ea0b0f8bad |
parent 216 | 38ed0ed6de3d |
child 220 | 262fc2c6371b |
permissions | -rw-r--r-- |
216
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
1 |
theory Rec_def2 |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
2 |
imports Main |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
3 |
begin |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
4 |
|
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
5 |
datatype recf = z |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
6 |
| s |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
7 |
| id nat nat |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
8 |
| Cn nat recf "recf list" |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
9 |
| Pr nat recf recf |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
10 |
| Mn nat recf |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
11 |
|
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
12 |
function rec_exec :: "recf \<Rightarrow> nat list \<Rightarrow> nat" |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
13 |
where |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
14 |
"rec_exec z xs = 0" | |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
15 |
"rec_exec s xs = (Suc (xs ! 0))" | |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
16 |
"rec_exec (id m n) xs = (xs ! n)" | |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
17 |
"rec_exec (Cn n f gs) xs = |
219
a3ea0b0f8bad
updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
216
diff
changeset
|
18 |
rec_exec f (map (\<lambda> a. rec_exec a xs) gs)" | |
216
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
19 |
"rec_exec (Pr n f g) xs = |
219
a3ea0b0f8bad
updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
216
diff
changeset
|
20 |
(if hd xs = 0 then rec_exec f (tl xs) |
a3ea0b0f8bad
updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
216
diff
changeset
|
21 |
else rec_exec g ((hd xs - 1) # (rec_exec (Pr n f g) ((hd xs - 1) # tl xs)) # tl xs))" | |
216
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
22 |
"rec_exec (Mn n f) xs = (LEAST x. rec_exec f (x # xs) = 0)" |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
23 |
by pat_completeness auto |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
24 |
|
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
25 |
termination |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
26 |
apply(relation "measures [\<lambda> (r, xs). size r, (\<lambda> (r, xs). hd xs)]") |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
27 |
apply(auto simp add: less_Suc_eq_le intro: trans_le_add2 list_size_estimation') |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
28 |
done |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
29 |
|
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
30 |
inductive terminate :: "recf \<Rightarrow> nat list \<Rightarrow> bool" |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
31 |
where |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
32 |
termi_z: "terminate z [n]" |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
33 |
| termi_s: "terminate s [n]" |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
34 |
| termi_id: "\<lbrakk>n < m; length xs = m\<rbrakk> \<Longrightarrow> terminate (id m n) xs" |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
35 |
| termi_cn: "\<lbrakk>terminate f (map (\<lambda>g. rec_exec g xs) gs); |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
36 |
\<forall>g \<in> set gs. terminate g xs; length xs = n\<rbrakk> \<Longrightarrow> terminate (Cn n f gs) xs" |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
37 |
| termi_pr_0: "\<lbrakk>terminate f xs; length xs = n\<rbrakk> \<Longrightarrow> terminate (Pr n f g) (0 # xs)" |
219
a3ea0b0f8bad
updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
216
diff
changeset
|
38 |
| termi_pr_suc: "\<lbrakk>terminate g (x # rec_exec (Pr n f gs) (x # xs) # xs)\<rbrakk> |
216
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
39 |
\<Longrightarrow> terminate (Pr n f gs) (Suc x # xs)" |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
40 |
| termi_mn: "\<lbrakk>length xs = n; rec_exec f (r # xs) = 0; |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
41 |
\<forall> i < r. terminate f (i # xs) \<and> rec_exec f (i # xs) > 0\<rbrakk> \<Longrightarrow> terminate (Mn n f) xs" |
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
42 |
|
38ed0ed6de3d
added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
43 |
end |