src/HOL/ex/Recdef.thy
author nipkow
Tue, 05 Aug 1997 16:22:17 +0200
changeset 3590 4d307341d0af
parent 3418 f060dc3f15a8
child 3842 b55686a7b22c
permissions -rw-r--r--
Added example mapf which requires a special congruence rule.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
3412
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
     1
(*  Title:      HOL/ex/Recdef.thy
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
     2
    ID:         $Id$
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
     3
    Author:     Konrad Slind and Lawrence C Paulson
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
     4
    Copyright   1996  University of Cambridge
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
     5
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
     6
Examples of recdef definitions.  Most, but not all, are handled automatically.
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
     7
*)
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
     8
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
     9
Recdef = WF_Rel + List +
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    10
3418
f060dc3f15a8 Two new examples; corrected a comment
paulson
parents: 3412
diff changeset
    11
consts fact :: "nat => nat"
f060dc3f15a8 Two new examples; corrected a comment
paulson
parents: 3412
diff changeset
    12
recdef fact "less_than"
f060dc3f15a8 Two new examples; corrected a comment
paulson
parents: 3412
diff changeset
    13
    "fact x = (if (x = 0) then 1 else x * fact (x - 1))"
f060dc3f15a8 Two new examples; corrected a comment
paulson
parents: 3412
diff changeset
    14
f060dc3f15a8 Two new examples; corrected a comment
paulson
parents: 3412
diff changeset
    15
consts Fact :: "nat => nat"
f060dc3f15a8 Two new examples; corrected a comment
paulson
parents: 3412
diff changeset
    16
recdef Fact "less_than"
f060dc3f15a8 Two new examples; corrected a comment
paulson
parents: 3412
diff changeset
    17
    "Fact 0 = 1"
f060dc3f15a8 Two new examples; corrected a comment
paulson
parents: 3412
diff changeset
    18
    "Fact (Suc x) = (Fact x * Suc x)"
f060dc3f15a8 Two new examples; corrected a comment
paulson
parents: 3412
diff changeset
    19
3412
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    20
consts map2 :: "('a => 'b => 'c) * 'a list * 'b list => 'c list"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    21
recdef map2 "measure(%(f,l1,l2).size l1)"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    22
    "map2(f, [], [])  = []"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    23
    "map2(f, h#t, []) = []"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    24
    "map2(f, h1#t1, h2#t2) = f h1 h2 # map2 (f, t1, t2)"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    25
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    26
consts finiteRchain :: "(['a,'a] => bool) * 'a list => bool"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    27
recdef finiteRchain "measure (%(R,l).size l)"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    28
    "finiteRchain(R,  []) = True"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    29
    "finiteRchain(R, [x]) = True"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    30
    "finiteRchain(R, x#y#rst) = (R x y & finiteRchain(R, y#rst))"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    31
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    32
consts qsort   ::"('a => 'a => bool) * 'a list => 'a list"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    33
recdef qsort "measure (size o snd)"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    34
    simpset "!simpset addsimps [le_eq_less_Suc RS sym, filter_size]"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    35
    "qsort(ord, [])    = []"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    36
    "qsort(ord, x#rst) = qsort(ord, filter(Not o ord x) rst)  
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    37
                         @ [x] @   
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    38
                         qsort(ord, filter(ord x) rst)"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    39
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    40
(*Not handled automatically: too complicated.*)
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    41
consts variant :: "nat * nat list => nat"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    42
recdef variant "measure(%(n::nat, ns). size(filter(%y. n <= y) ns))"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    43
    "variant(x, L) = (if (x mem L) then variant(Suc x, L) else x)"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    44
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    45
consts gcd :: "nat * nat => nat"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    46
recdef gcd "measure (%(x,y).x+y)"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    47
    simpset "!simpset addsimps [le_eq_less_Suc RS sym, le_add1, diff_le_self]"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    48
    "gcd (0,y)          = y"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    49
    "gcd (Suc x, 0)     = Suc x"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    50
    "gcd (Suc x, Suc y) = (if (y <= x) then gcd(x - y, Suc y)  
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    51
                                       else gcd(Suc x, y - x))"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    52
3418
f060dc3f15a8 Two new examples; corrected a comment
paulson
parents: 3412
diff changeset
    53
(*Not handled automatically.  In fact, g is the zero constant function.*)
3412
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    54
consts g   :: "nat => nat"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    55
recdef g "less_than"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    56
    "g 0 = 0"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    57
    "g(Suc x) = g(g x)"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    58
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    59
consts Div :: "nat * nat => nat * nat"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    60
recdef Div "measure fst"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    61
    "Div(0,x)      = (0,0)"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    62
    "Div(Suc x, y) =      
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    63
         (let (q,r) = Div(x,y)
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    64
          in                      
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    65
          if (y <= Suc r) then (Suc q,0) else (q, Suc r))"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    66
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    67
(*Not handled automatically.  Should be the predecessor function, but there
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    68
  is an unnecessary "looping" recursive call in k(1) *)
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    69
consts k   :: "nat => nat"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    70
recdef k "less_than"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    71
    "k 0 = 0"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    72
    "k (Suc n) = (let x = k 1  
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    73
                  in if (0=1) then k (Suc 1) else n)"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    74
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    75
consts part :: "('a=>bool) * 'a list * 'a list * 'a list => 'a list * 'a list"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    76
recdef part "measure (%(P,l,l1,l2).size l)"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    77
    "part(P, [], l1,l2) = (l1,l2)"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    78
    "part(P, h#rst, l1,l2) =  
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    79
        (if P h then part(P,rst, h#l1,  l2)  
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    80
                else part(P,rst,  l1,  h#l2))"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    81
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    82
consts fqsort :: "(['a,'a] => bool) * 'a list => 'a list"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    83
recdef fqsort "measure (size o snd)"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    84
    "fqsort(ord,[]) = []"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    85
    "fqsort(ord, x#rst) =    
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    86
     (let (less,more) = part((%y. ord y x), rst, ([],[]))
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    87
      in  
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    88
      fqsort(ord,less)@[x]@fqsort(ord,more))"
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
    89
3590
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3418
diff changeset
    90
(* silly example which demonstrates the occasional need for additional
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3418
diff changeset
    91
   congruence rules (here: map_cong from List). If the congruence rule is
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3418
diff changeset
    92
   removed, an unprovable termination condition is generated!
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3418
diff changeset
    93
   Termination not proved automatically; see the ML file.
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3418
diff changeset
    94
   TFL requires (%x.mapf x) instead of mapf.
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3418
diff changeset
    95
*)
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3418
diff changeset
    96
consts mapf :: nat => nat list
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3418
diff changeset
    97
recdef mapf "measure(%m.m)"
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3418
diff changeset
    98
congs "[map_cong]"
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3418
diff changeset
    99
"mapf 0 = []"
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3418
diff changeset
   100
"mapf (Suc n) = concat(map (%x.mapf x) (replicate n n))"
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3418
diff changeset
   101
3412
5b658dadf560 New recdef examples
paulson
parents:
diff changeset
   102
end