src/CCL/ex/Nat.thy
changeset 42155 ffe99b07c9c0
parent 35762 af3ff2ba4c54
child 58889 5b7a9633cfa8
equal deleted inserted replaced
42154:478bdcea240a 42155:ffe99b07c9c0
     7 
     7 
     8 theory Nat
     8 theory Nat
     9 imports Wfd
     9 imports Wfd
    10 begin
    10 begin
    11 
    11 
    12 consts
    12 definition not :: "i=>i"
       
    13   where "not(b) == if b then false else true"
    13 
    14 
    14   not   :: "i=>i"
    15 definition add :: "[i,i]=>i"  (infixr "#+" 60)
    15   add   :: "[i,i]=>i"            (infixr "#+" 60)
    16   where "a #+ b == nrec(a,b,%x g. succ(g))"
    16   mult  :: "[i,i]=>i"            (infixr "#*" 60)
       
    17   sub   :: "[i,i]=>i"            (infixr "#-" 60)
       
    18   div   :: "[i,i]=>i"            (infixr "##" 60)
       
    19   lt    :: "[i,i]=>i"            (infixr "#<" 60)
       
    20   le    :: "[i,i]=>i"            (infixr "#<=" 60)
       
    21   ackermann :: "[i,i]=>i"
       
    22 
    17 
    23 defs
    18 definition mult :: "[i,i]=>i"  (infixr "#*" 60)
       
    19   where "a #* b == nrec(a,zero,%x g. b #+ g)"
    24 
    20 
    25   not_def:     "not(b) == if b then false else true"
    21 definition sub :: "[i,i]=>i"  (infixr "#-" 60)
       
    22   where
       
    23     "a #- b ==
       
    24       letrec sub x y be ncase(y,x,%yy. ncase(x,zero,%xx. sub(xx,yy)))
       
    25       in sub(a,b)"
    26 
    26 
    27   add_def:     "a #+ b == nrec(a,b,%x g. succ(g))"
    27 definition le :: "[i,i]=>i"  (infixr "#<=" 60)
    28   mult_def:    "a #* b == nrec(a,zero,%x g. b #+ g)"
    28   where
    29   sub_def:     "a #- b == letrec sub x y be ncase(y,x,%yy. ncase(x,zero,%xx. sub(xx,yy)))
    29     "a #<= b ==
    30                         in sub(a,b)"
    30       letrec le x y be ncase(x,true,%xx. ncase(y,false,%yy. le(xx,yy)))
    31   le_def:     "a #<= b == letrec le x y be ncase(x,true,%xx. ncase(y,false,%yy. le(xx,yy)))
    31       in le(a,b)"
    32                         in le(a,b)"
       
    33   lt_def:     "a #< b == not(b #<= a)"
       
    34 
    32 
    35   div_def:    "a ## b == letrec div x y be if x #< y then zero else succ(div(x#-y,y))
    33 definition lt :: "[i,i]=>i"  (infixr "#<" 60)
    36                        in div(a,b)"
    34   where "a #< b == not(b #<= a)"
    37   ack_def:
       
    38   "ackermann(a,b) == letrec ack n m be ncase(n,succ(m),%x.
       
    39                           ncase(m,ack(x,succ(zero)),%y. ack(x,ack(succ(x),y))))
       
    40                     in ack(a,b)"
       
    41 
    35 
    42 lemmas nat_defs = not_def add_def mult_def sub_def le_def lt_def ack_def napply_def
    36 definition div :: "[i,i]=>i"  (infixr "##" 60)
       
    37   where
       
    38     "a ## b ==
       
    39       letrec div x y be if x #< y then zero else succ(div(x#-y,y))
       
    40       in div(a,b)"
       
    41 
       
    42 definition ackermann :: "[i,i]=>i"
       
    43   where
       
    44     "ackermann(a,b) ==
       
    45       letrec ack n m be ncase(n,succ(m),%x.
       
    46         ncase(m,ack(x,succ(zero)),%y. ack(x,ack(succ(x),y))))
       
    47       in ack(a,b)"
       
    48 
       
    49 lemmas nat_defs = not_def add_def mult_def sub_def le_def lt_def ackermann_def napply_def
    43 
    50 
    44 lemma natBs [simp]:
    51 lemma natBs [simp]:
    45   "not(true) = false"
    52   "not(true) = false"
    46   "not(false) = true"
    53   "not(false) = true"
    47   "zero #+ n = n"
    54   "zero #+ n = n"
    92 subsection {* Termination Conditions for Ackermann's Function *}
    99 subsection {* Termination Conditions for Ackermann's Function *}
    93 
   100 
    94 lemmas relI = NatPR_wf [THEN NatPR_wf [THEN lex_wf, THEN wfI]]
   101 lemmas relI = NatPR_wf [THEN NatPR_wf [THEN lex_wf, THEN wfI]]
    95 
   102 
    96 lemma "[| a:Nat;  b:Nat |] ==> ackermann(a,b) : Nat"
   103 lemma "[| a:Nat;  b:Nat |] ==> ackermann(a,b) : Nat"
    97   apply (unfold ack_def)
   104   apply (unfold ackermann_def)
    98   apply (tactic {* gen_ccs_tac @{context} [] 1 *})
   105   apply (tactic {* gen_ccs_tac @{context} [] 1 *})
    99   apply (erule NatPRI [THEN lexI1 [THEN relI]] NatPRI [THEN lexI2 [THEN relI]])+
   106   apply (erule NatPRI [THEN lexI1 [THEN relI]] NatPRI [THEN lexI2 [THEN relI]])+
   100   done
   107   done
   101 
   108 
   102 end
   109 end