src/HOL/IMP/Natural.ML
author nipkow
Thu, 26 Nov 1998 12:18:08 +0100
changeset 5974 6acf3ff0f486
parent 5789 7d4ac02677a6
child 6141 a6922171b396
permissions -rw-r--r--
Added filter_prems_tac
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1700
afd3b60660db Natural and Transition semantics.
nipkow
parents:
diff changeset
     1
(*  Title:      HOL/IMP/Natural.ML
afd3b60660db Natural and Transition semantics.
nipkow
parents:
diff changeset
     2
    ID:         $Id$
afd3b60660db Natural and Transition semantics.
nipkow
parents:
diff changeset
     3
    Author:     Tobias Nipkow & Larry Paulson, TUM
afd3b60660db Natural and Transition semantics.
nipkow
parents:
diff changeset
     4
    Copyright   1996 TUM
afd3b60660db Natural and Transition semantics.
nipkow
parents:
diff changeset
     5
*)
afd3b60660db Natural and Transition semantics.
nipkow
parents:
diff changeset
     6
afd3b60660db Natural and Transition semantics.
nipkow
parents:
diff changeset
     7
open Natural;
afd3b60660db Natural and Transition semantics.
nipkow
parents:
diff changeset
     8
1973
8c94c9a5be10 Converted proofs to use default clasets.
nipkow
parents: 1958
diff changeset
     9
AddIs evalc.intrs;
8c94c9a5be10 Converted proofs to use default clasets.
nipkow
parents: 1958
diff changeset
    10
1700
afd3b60660db Natural and Transition semantics.
nipkow
parents:
diff changeset
    11
val evalc_elim_cases = map (evalc.mk_cases com.simps)
afd3b60660db Natural and Transition semantics.
nipkow
parents:
diff changeset
    12
   ["<SKIP,s> -c-> t", "<x:=a,s> -c-> t", "<c1;c2, s> -c-> t",
afd3b60660db Natural and Transition semantics.
nipkow
parents:
diff changeset
    13
    "<IF b THEN c1 ELSE c2, s> -c-> t"];
afd3b60660db Natural and Transition semantics.
nipkow
parents:
diff changeset
    14
afd3b60660db Natural and Transition semantics.
nipkow
parents:
diff changeset
    15
val evalc_WHILE_case = evalc.mk_cases com.simps "<WHILE b DO c,s> -c-> t";
afd3b60660db Natural and Transition semantics.
nipkow
parents:
diff changeset
    16
1973
8c94c9a5be10 Converted proofs to use default clasets.
nipkow
parents: 1958
diff changeset
    17
AddSEs evalc_elim_cases;
1700
afd3b60660db Natural and Transition semantics.
nipkow
parents:
diff changeset
    18
afd3b60660db Natural and Transition semantics.
nipkow
parents:
diff changeset
    19
(* evaluation of com is deterministic *)
5117
7b5efef2ca74 Removed leading !! in goals.
nipkow
parents: 5069
diff changeset
    20
Goal "<c,s> -c-> t ==> (!u. <c,s> -c-> u --> u=t)";
1730
1c7f793fc374 Updated for new form of induction rules
paulson
parents: 1700
diff changeset
    21
by (etac evalc.induct 1);
1958
6f20ecbd87cb Now uses thin_tac
paulson
parents: 1730
diff changeset
    22
by (thin_tac "<?c,s2> -c-> s1" 7);
4241
3f3f87c6fe3b Got rid of some slow deepen_tac calls
paulson
parents: 4089
diff changeset
    23
(*blast_tac needs Unify.search_bound, trace_bound := 40*)
3f3f87c6fe3b Got rid of some slow deepen_tac calls
paulson
parents: 4089
diff changeset
    24
by (ALLGOALS (best_tac (claset() addEs [evalc_WHILE_case])));
1700
afd3b60660db Natural and Transition semantics.
nipkow
parents:
diff changeset
    25
qed_spec_mp "com_det";
5789
7d4ac02677a6 New example
nipkow
parents: 5117
diff changeset
    26
7d4ac02677a6 New example
nipkow
parents: 5117
diff changeset
    27
(** An example due to Tony Hoare **)
7d4ac02677a6 New example
nipkow
parents: 5117
diff changeset
    28
7d4ac02677a6 New example
nipkow
parents: 5117
diff changeset
    29
Goal "[| !x. P x --> Q x; <w,s> -c-> t |] ==> \
7d4ac02677a6 New example
nipkow
parents: 5117
diff changeset
    30
\ !c. w = While P c --> <While Q c,t> -c-> u --> <While Q c,s> -c-> u";
7d4ac02677a6 New example
nipkow
parents: 5117
diff changeset
    31
be evalc.induct 1;
7d4ac02677a6 New example
nipkow
parents: 5117
diff changeset
    32
by(Auto_tac);
7d4ac02677a6 New example
nipkow
parents: 5117
diff changeset
    33
val lemma1 = result() RS spec RS mp RS mp;
7d4ac02677a6 New example
nipkow
parents: 5117
diff changeset
    34
7d4ac02677a6 New example
nipkow
parents: 5117
diff changeset
    35
Goal "[| !x. P x --> Q x; <w,s> -c-> u |] ==> \
7d4ac02677a6 New example
nipkow
parents: 5117
diff changeset
    36
\ !c. w = While Q c --> <While P c; While Q c,s> -c-> u";
7d4ac02677a6 New example
nipkow
parents: 5117
diff changeset
    37
be evalc.induct 1;
7d4ac02677a6 New example
nipkow
parents: 5117
diff changeset
    38
by(ALLGOALS Asm_simp_tac);
7d4ac02677a6 New example
nipkow
parents: 5117
diff changeset
    39
by(Blast_tac 1);
7d4ac02677a6 New example
nipkow
parents: 5117
diff changeset
    40
by(case_tac "P s" 1);
7d4ac02677a6 New example
nipkow
parents: 5117
diff changeset
    41
by(Auto_tac);
7d4ac02677a6 New example
nipkow
parents: 5117
diff changeset
    42
val lemma2 = result() RS spec RS mp;
7d4ac02677a6 New example
nipkow
parents: 5117
diff changeset
    43
7d4ac02677a6 New example
nipkow
parents: 5117
diff changeset
    44
Goal "!x. P x --> Q x ==> \
7d4ac02677a6 New example
nipkow
parents: 5117
diff changeset
    45
\ (<While P c; While Q c, s> -c-> t) = (<While Q c, s> -c-> t)";
7d4ac02677a6 New example
nipkow
parents: 5117
diff changeset
    46
by(blast_tac (claset() addIs [lemma1,lemma2]) 1);
7d4ac02677a6 New example
nipkow
parents: 5117
diff changeset
    47
qed "Hoare_example";