src/CCL/ex/Nat.ML
author urbanc
Tue, 13 Dec 2005 18:11:21 +0100
changeset 18396 b3e7da94b51f
parent 17456 bcf7544875b2
permissions -rw-r--r--
added a fresh_left lemma that contains all instantiation for the various atom-types.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
17456
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 1459
diff changeset
     1
(*  Title:      CCL/ex/Nat.ML
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     2
    ID:         $Id$
1459
d12da312eff4 expanded tabs
clasohm
parents: 757
diff changeset
     3
    Author:     Martin Coen, Cambridge University Computer Laboratory
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     4
    Copyright   1993  University of Cambridge
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     5
*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     6
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     7
val nat_defs = [not_def,add_def,mult_def,sub_def,le_def,lt_def,ack_def,napply_def];
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     8
17456
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 1459
diff changeset
     9
val natBs = map (fn s=>prove_goalw (the_context ()) nat_defs s (fn _ => [simp_tac term_ss 1]))
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    10
     ["not(true) = false",
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    11
      "not(false) = true",
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    12
      "zero #+ n = n",
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    13
      "succ(n) #+ m = succ(n #+ m)",
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    14
      "zero #* n = zero",
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    15
      "succ(n) #* m = m #+ (n #* m)",
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    16
      "f^zero`a = a",
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    17
      "f^succ(n)`a = f(f^n`a)"];
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    18
8
c3d2c6dcf3f0 Installation of new simplfier. Previously appeared to set up the old
lcp
parents: 0
diff changeset
    19
val nat_ss = term_ss addsimps natBs;
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    20
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    21
(*** Lemma for napply ***)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    22
17456
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 1459
diff changeset
    23
val [prem] = goal (the_context ()) "n:Nat ==> f^n`f(a) = f^succ(n)`a";
1459
d12da312eff4 expanded tabs
clasohm
parents: 757
diff changeset
    24
by (rtac (prem RS Nat_ind) 1);
8
c3d2c6dcf3f0 Installation of new simplfier. Previously appeared to set up the old
lcp
parents: 0
diff changeset
    25
by (ALLGOALS (asm_simp_tac nat_ss));
757
2ca12511676d added qed and qed_goal[w]
clasohm
parents: 8
diff changeset
    26
qed "napply_f";
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    27
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    28
(****)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    29
17456
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 1459
diff changeset
    30
val prems = goalw (the_context ()) [add_def] "[| a:Nat;  b:Nat |] ==> a #+ b : Nat";
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    31
by (typechk_tac prems 1);
757
2ca12511676d added qed and qed_goal[w]
clasohm
parents: 8
diff changeset
    32
qed "addT";
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    33
17456
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 1459
diff changeset
    34
val prems = goalw (the_context ()) [mult_def] "[| a:Nat;  b:Nat |] ==> a #* b : Nat";
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    35
by (typechk_tac (addT::prems) 1);
757
2ca12511676d added qed and qed_goal[w]
clasohm
parents: 8
diff changeset
    36
qed "multT";
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    37
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    38
(* Defined to return zero if a<b *)
17456
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 1459
diff changeset
    39
val prems = goalw (the_context ()) [sub_def] "[| a:Nat;  b:Nat |] ==> a #- b : Nat";
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    40
by (typechk_tac (prems) 1);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    41
by clean_ccs_tac;
1459
d12da312eff4 expanded tabs
clasohm
parents: 757
diff changeset
    42
by (etac (NatPRI RS wfstI RS (NatPR_wf RS wmap_wf RS wfI)) 1);
757
2ca12511676d added qed and qed_goal[w]
clasohm
parents: 8
diff changeset
    43
qed "subT";
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    44
17456
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 1459
diff changeset
    45
val prems = goalw (the_context ()) [le_def] "[| a:Nat;  b:Nat |] ==> a #<= b : Bool";
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    46
by (typechk_tac (prems) 1);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    47
by clean_ccs_tac;
1459
d12da312eff4 expanded tabs
clasohm
parents: 757
diff changeset
    48
by (etac (NatPRI RS wfstI RS (NatPR_wf RS wmap_wf RS wfI)) 1);
757
2ca12511676d added qed and qed_goal[w]
clasohm
parents: 8
diff changeset
    49
qed "leT";
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    50
17456
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 1459
diff changeset
    51
val prems = goalw (the_context ()) [not_def,lt_def] "[| a:Nat;  b:Nat |] ==> a #< b : Bool";
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    52
by (typechk_tac (prems@[leT]) 1);
757
2ca12511676d added qed and qed_goal[w]
clasohm
parents: 8
diff changeset
    53
qed "ltT";
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    54
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    55
(* Correctness conditions for subtractive division **)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    56
17456
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 1459
diff changeset
    57
val prems = goalw (the_context ()) [div_def]
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    58
    "[| a:Nat;  b:{x:Nat.~x=zero} |] ==> a ## b : {x:Nat. DIV(a,b,x)}";
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    59
by (gen_ccs_tac (prems@[ltT,subT]) 1);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    60
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    61
(* Termination Conditions for Ackermann's Function *)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    62
17456
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 1459
diff changeset
    63
val prems = goalw (the_context ()) [ack_def]
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    64
    "[| a:Nat;  b:Nat |] ==> ackermann(a,b) : Nat";
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    65
by (gen_ccs_tac prems 1);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    66
val relI = NatPR_wf RS (NatPR_wf RS lex_wf RS wfI);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    67
by (REPEAT (eresolve_tac [NatPRI RS (lexI1 RS relI),NatPRI RS (lexI2 RS relI)] 1));
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    68
result();