author | krauss |
Wed, 28 Feb 2007 16:35:00 +0100 | |
changeset 22375 | 823f7bee42df |
parent 22371 | c9f5895972b0 |
child 22492 | 43545e640877 |
permissions | -rw-r--r-- |
22371 | 1 |
(* Title: HOL/Library/SCT_Examples.thy |
2 |
ID: $Id$ |
|
3 |
Author: Alexander Krauss, TU Muenchen |
|
4 |
*) |
|
5 |
||
22359
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
6 |
theory SCT_Examples |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
7 |
imports Size_Change_Termination |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
8 |
begin |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
9 |
|
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
10 |
function f :: "nat \<Rightarrow> nat \<Rightarrow> nat" |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
11 |
where |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
12 |
"f n 0 = n" |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
13 |
| "f 0 (Suc m) = f (Suc m) m" |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
14 |
| "f (Suc n) (Suc m) = f m n" |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
15 |
by pat_completeness auto |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
16 |
|
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
17 |
|
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
18 |
termination |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
19 |
unfolding f_rel_def lfp_const |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
20 |
apply (rule SCT_on_relations) |
22375 | 21 |
apply (tactic "Sct.abs_rel_tac") (* Build call descriptors *) |
22359
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
22 |
apply (rule ext, rule ext, simp) (* Show that they are correct *) |
22375 | 23 |
apply (tactic "Sct.mk_call_graph") (* Build control graph *) |
22359
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
24 |
apply (rule LJA_apply) (* Apply main theorem *) |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
25 |
apply (simp add:finite_acg_ins finite_acg_empty) (* show finiteness *) |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
26 |
apply (rule SCT'_exec) |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
27 |
by eval (* Evaluate to true *) |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
28 |
|
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
29 |
function p :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
30 |
where |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
31 |
"p m n r = (if r>0 then p m (r - 1) n else |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
32 |
if n>0 then p r (n - 1) m |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
33 |
else m)" |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
34 |
by pat_completeness auto |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
35 |
|
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
36 |
termination |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
37 |
unfolding p_rel_def lfp_const |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
38 |
apply (rule SCT_on_relations) |
22375 | 39 |
apply (tactic "Sct.abs_rel_tac") |
22359
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
40 |
apply (rule ext, rule ext, simp) |
22375 | 41 |
apply (tactic "Sct.mk_call_graph") |
22359
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
42 |
apply (rule LJA_apply) |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
43 |
apply (simp add:finite_acg_ins finite_acg_empty) |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
44 |
apply (rule SCT'_exec) |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
45 |
by eval |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
46 |
|
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
47 |
function foo :: "bool \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
48 |
where |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
49 |
"foo True (Suc n) m = foo True n (Suc m)" |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
50 |
"foo True 0 m = foo False 0 m" |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
51 |
"foo False n (Suc m) = foo False (Suc n) m" |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
52 |
"foo False n 0 = n" |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
53 |
by pat_completeness auto |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
54 |
|
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
55 |
termination |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
56 |
unfolding foo_rel_def lfp_const |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
57 |
apply (rule SCT_on_relations) |
22375 | 58 |
apply (tactic "Sct.abs_rel_tac") |
22359
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
59 |
apply (rule ext, rule ext, simp) |
22375 | 60 |
apply (tactic "Sct.mk_call_graph") |
22359
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
61 |
apply (rule LJA_apply) |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
62 |
apply (simp add:finite_acg_ins finite_acg_empty) |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
63 |
apply (rule SCT'_exec) |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
64 |
by eval |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
65 |
|
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
66 |
function (sequential) |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
67 |
bar :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
68 |
where |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
69 |
"bar 0 (Suc n) m = bar m m m" |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
70 |
| "bar k n m = 0" |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
71 |
by pat_completeness auto |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
72 |
|
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
73 |
termination |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
74 |
unfolding bar_rel_def lfp_const |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
75 |
apply (rule SCT_on_relations) |
22375 | 76 |
apply (tactic "Sct.abs_rel_tac") |
22359
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
77 |
apply (rule ext, rule ext, simp) |
22375 | 78 |
apply (tactic "Sct.mk_call_graph") |
22359
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
79 |
apply (rule LJA_apply) |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
80 |
apply (simp add:finite_acg_ins finite_acg_empty) |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
81 |
by (rule SCT'_empty) |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
82 |
|
22371 | 83 |
end |