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