src/HOL/IMP/Hoare.ML
author nipkow
Thu, 12 Oct 2000 13:01:19 +0200
changeset 10202 9e8b4bebc940
parent 10186 499637e8f2c6
permissions -rw-r--r--
induct -> lfp_induct
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1465
5d7a7e439cec expanded tabs
clasohm
parents: 1447
diff changeset
     1
(*  Title:      HOL/IMP/Hoare.ML
938
621be7ec81d7 *** empty log message ***
nipkow
parents: 936
diff changeset
     2
    ID:         $Id$
1465
5d7a7e439cec expanded tabs
clasohm
parents: 1447
diff changeset
     3
    Author:     Tobias Nipkow
936
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
     4
    Copyright   1995 TUM
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
     5
1481
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
     6
Soundness (and part of) relative completeness of Hoare rules
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
     7
wrt denotational semantics
936
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
     8
*)
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
     9
5301
e24d15594edd streamlined proofs with new hoare_conseq1, hoare_conseq2
oheimb
parents: 5278
diff changeset
    10
Goal "[| !s. P' s --> P s; |- {P}c{Q} |] ==> |- {P'}c{Q}";
e24d15594edd streamlined proofs with new hoare_conseq1, hoare_conseq2
oheimb
parents: 5278
diff changeset
    11
by (etac hoare.conseq 1);
5515
903c956beac3 simplified proof
oheimb
parents: 5301
diff changeset
    12
by  (atac 1);
903c956beac3 simplified proof
oheimb
parents: 5301
diff changeset
    13
by (Fast_tac 1);
5301
e24d15594edd streamlined proofs with new hoare_conseq1, hoare_conseq2
oheimb
parents: 5278
diff changeset
    14
qed "hoare_conseq1";
e24d15594edd streamlined proofs with new hoare_conseq1, hoare_conseq2
oheimb
parents: 5278
diff changeset
    15
e24d15594edd streamlined proofs with new hoare_conseq1, hoare_conseq2
oheimb
parents: 5278
diff changeset
    16
Goal "[| |- {P}c{Q}; !s. Q s --> Q' s |] ==> |- {P}c{Q'}";
e24d15594edd streamlined proofs with new hoare_conseq1, hoare_conseq2
oheimb
parents: 5278
diff changeset
    17
by (rtac hoare.conseq 1);
e24d15594edd streamlined proofs with new hoare_conseq1, hoare_conseq2
oheimb
parents: 5278
diff changeset
    18
by    (atac 2);
e24d15594edd streamlined proofs with new hoare_conseq1, hoare_conseq2
oheimb
parents: 5278
diff changeset
    19
by   (ALLGOALS Fast_tac);
e24d15594edd streamlined proofs with new hoare_conseq1, hoare_conseq2
oheimb
parents: 5278
diff changeset
    20
qed "hoare_conseq2";
e24d15594edd streamlined proofs with new hoare_conseq1, hoare_conseq2
oheimb
parents: 5278
diff changeset
    21
5117
7b5efef2ca74 Removed leading !! in goals.
nipkow
parents: 5069
diff changeset
    22
Goalw [hoare_valid_def] "|- {P}c{Q} ==> |= {P}c{Q}";
1730
1c7f793fc374 Updated for new form of induction rules
paulson
parents: 1696
diff changeset
    23
by (etac hoare.induct 1);
5301
e24d15594edd streamlined proofs with new hoare_conseq1, hoare_conseq2
oheimb
parents: 5278
diff changeset
    24
     by (ALLGOALS Asm_simp_tac);
1973
8c94c9a5be10 Converted proofs to use default clasets.
nipkow
parents: 1910
diff changeset
    25
  by (Fast_tac 1);
1910
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    26
 by (Fast_tac 1);
5301
e24d15594edd streamlined proofs with new hoare_conseq1, hoare_conseq2
oheimb
parents: 5278
diff changeset
    27
by (EVERY' [rtac allI, rtac allI, rtac impI] 1);
10202
9e8b4bebc940 induct -> lfp_induct
nipkow
parents: 10186
diff changeset
    28
by (etac lfp_induct2 1);
2055
cc274e47f607 Ran expandshort
paulson
parents: 2031
diff changeset
    29
 by (rtac Gamma_mono 1);
1465
5d7a7e439cec expanded tabs
clasohm
parents: 1447
diff changeset
    30
by (rewtac Gamma_def);  
1973
8c94c9a5be10 Converted proofs to use default clasets.
nipkow
parents: 1910
diff changeset
    31
by (Fast_tac 1);
1730
1c7f793fc374 Updated for new form of induction rules
paulson
parents: 1696
diff changeset
    32
qed "hoare_sound";
936
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    33
5069
3ea049f7979d isatool fixgoal;
wenzelm
parents: 4897
diff changeset
    34
Goalw [wp_def] "wp SKIP Q = Q";
2031
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    35
by (Simp_tac 1);
2810
c4e16b36bc57 Added wp_while.
nipkow
parents: 2055
diff changeset
    36
qed "wp_SKIP";
1481
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
    37
9241
f961c1fdff50 disambiguated := ; added Examples (factorial)
oheimb
parents: 5515
diff changeset
    38
Goalw [wp_def] "wp (x:==a) Q = (%s. Q(s[x::=a s]))";
2031
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    39
by (Simp_tac 1);
2810
c4e16b36bc57 Added wp_while.
nipkow
parents: 2055
diff changeset
    40
qed "wp_Ass";
1481
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
    41
5069
3ea049f7979d isatool fixgoal;
wenzelm
parents: 4897
diff changeset
    42
Goalw [wp_def] "wp (c;d) Q = wp c (wp d Q)";
2031
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    43
by (Simp_tac 1);
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    44
by (rtac ext 1);
1910
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    45
by (Fast_tac 1);
2810
c4e16b36bc57 Added wp_while.
nipkow
parents: 2055
diff changeset
    46
qed "wp_Semi";
936
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    47
5069
3ea049f7979d isatool fixgoal;
wenzelm
parents: 4897
diff changeset
    48
Goalw [wp_def]
5117
7b5efef2ca74 Removed leading !! in goals.
nipkow
parents: 5069
diff changeset
    49
 "wp (IF b THEN c ELSE d) Q = (%s. (b s --> wp c Q s) &  (~b s --> wp d Q s))";
2031
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    50
by (Simp_tac 1);
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    51
by (rtac ext 1);
1910
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    52
by (Fast_tac 1);
2810
c4e16b36bc57 Added wp_while.
nipkow
parents: 2055
diff changeset
    53
qed "wp_If";
936
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    54
5069
3ea049f7979d isatool fixgoal;
wenzelm
parents: 4897
diff changeset
    55
Goalw [wp_def]
5117
7b5efef2ca74 Removed leading !! in goals.
nipkow
parents: 5069
diff changeset
    56
  "b s ==> wp (WHILE b DO c) Q s = wp (c;WHILE b DO c) Q s";
2031
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    57
by (stac C_While_If 1);
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    58
by (Asm_simp_tac 1);
2810
c4e16b36bc57 Added wp_while.
nipkow
parents: 2055
diff changeset
    59
qed "wp_While_True";
1481
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
    60
5117
7b5efef2ca74 Removed leading !! in goals.
nipkow
parents: 5069
diff changeset
    61
Goalw [wp_def] "~b s ==> wp (WHILE b DO c) Q s = Q s";
2031
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    62
by (stac C_While_If 1);
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    63
by (Asm_simp_tac 1);
2810
c4e16b36bc57 Added wp_while.
nipkow
parents: 2055
diff changeset
    64
qed "wp_While_False";
1481
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
    65
2810
c4e16b36bc57 Added wp_while.
nipkow
parents: 2055
diff changeset
    66
Addsimps [wp_SKIP,wp_Ass,wp_Semi,wp_If,wp_While_True,wp_While_False];
1481
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
    67
1910
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    68
(*Not suitable for rewriting: LOOPS!*)
5278
a903b66822e2 even more tidying of Goal commands
paulson
parents: 5223
diff changeset
    69
Goal "wp (WHILE b DO c) Q s = (if b s then wp (c;WHILE b DO c) Q s else Q s)";
4686
74a12e86b20b Removed `addsplits [expand_if]'
nipkow
parents: 4241
diff changeset
    70
by (Simp_tac 1);
2810
c4e16b36bc57 Added wp_while.
nipkow
parents: 2055
diff changeset
    71
qed "wp_While_if";
1910
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    72
5278
a903b66822e2 even more tidying of Goal commands
paulson
parents: 5223
diff changeset
    73
Goal "wp (WHILE b DO c) Q s = \
3842
b55686a7b22c fixed dots;
wenzelm
parents: 3737
diff changeset
    74
\  (s : gfp(%S.{s. if b s then wp c (%s. s:S) s else Q s}))";
4686
74a12e86b20b Removed `addsplits [expand_if]'
nipkow
parents: 4241
diff changeset
    75
by (Simp_tac 1);
3023
01364e2f30ad Ran expandshort
paulson
parents: 2861
diff changeset
    76
by (rtac iffI 1);
01364e2f30ad Ran expandshort
paulson
parents: 2861
diff changeset
    77
 by (rtac weak_coinduct 1);
01364e2f30ad Ran expandshort
paulson
parents: 2861
diff changeset
    78
  by (etac CollectI 1);
4153
e534c4c32d54 Ran expandshort, especially to introduce Safe_tac
paulson
parents: 4089
diff changeset
    79
 by Safe_tac;
3023
01364e2f30ad Ran expandshort
paulson
parents: 2861
diff changeset
    80
  by (rotate_tac ~1 1);
01364e2f30ad Ran expandshort
paulson
parents: 2861
diff changeset
    81
  by (Asm_full_simp_tac 1);
01364e2f30ad Ran expandshort
paulson
parents: 2861
diff changeset
    82
 by (rotate_tac ~1 1);
01364e2f30ad Ran expandshort
paulson
parents: 2861
diff changeset
    83
 by (Asm_full_simp_tac 1);
4089
96fba19bcbe2 isatool fixclasimp;
wenzelm
parents: 3919
diff changeset
    84
by (asm_full_simp_tac (simpset() addsimps [wp_def,Gamma_def]) 1);
3023
01364e2f30ad Ran expandshort
paulson
parents: 2861
diff changeset
    85
by (strip_tac 1);
01364e2f30ad Ran expandshort
paulson
parents: 2861
diff changeset
    86
by (rtac mp 1);
01364e2f30ad Ran expandshort
paulson
parents: 2861
diff changeset
    87
 by (assume_tac 2);
10202
9e8b4bebc940 induct -> lfp_induct
nipkow
parents: 10186
diff changeset
    88
by (etac lfp_induct2 1);
4089
96fba19bcbe2 isatool fixclasimp;
wenzelm
parents: 3919
diff changeset
    89
by (fast_tac (claset() addSIs [monoI]) 1);
10186
499637e8f2c6 *** empty log message ***
nipkow
parents: 9241
diff changeset
    90
by (stac gfp_unfold 1);
4089
96fba19bcbe2 isatool fixclasimp;
wenzelm
parents: 3919
diff changeset
    91
 by (fast_tac (claset() addSIs [monoI]) 1);
3023
01364e2f30ad Ran expandshort
paulson
parents: 2861
diff changeset
    92
by (Fast_tac 1);
2810
c4e16b36bc57 Added wp_while.
nipkow
parents: 2055
diff changeset
    93
qed "wp_While";
1910
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    94
1481
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
    95
Delsimps [C_while];
936
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    96
1910
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    97
AddSIs [hoare.skip, hoare.ass, hoare.semi, hoare.If];
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    98
5069
3ea049f7979d isatool fixgoal;
wenzelm
parents: 4897
diff changeset
    99
Goal "!Q. |- {wp c Q} c {Q}";
5183
89f162de39cf Adapted to new datatype package.
berghofe
parents: 5117
diff changeset
   100
by (induct_tac "c" 1);
5301
e24d15594edd streamlined proofs with new hoare_conseq1, hoare_conseq2
oheimb
parents: 5278
diff changeset
   101
    by (ALLGOALS Simp_tac);
e24d15594edd streamlined proofs with new hoare_conseq1, hoare_conseq2
oheimb
parents: 5278
diff changeset
   102
    by (REPEAT_FIRST Fast_tac);
e24d15594edd streamlined proofs with new hoare_conseq1, hoare_conseq2
oheimb
parents: 5278
diff changeset
   103
 by (blast_tac (claset() addIs [hoare_conseq1]) 1);
3737
3ea2f3b5e705 Step_tac -> Safe_tac
paulson
parents: 3023
diff changeset
   104
by Safe_tac;
5301
e24d15594edd streamlined proofs with new hoare_conseq1, hoare_conseq2
oheimb
parents: 5278
diff changeset
   105
by (rtac hoare_conseq2 1);
2055
cc274e47f607 Ran expandshort
paulson
parents: 2031
diff changeset
   106
 by (rtac hoare.While 1);
5301
e24d15594edd streamlined proofs with new hoare_conseq1, hoare_conseq2
oheimb
parents: 5278
diff changeset
   107
 by (rtac hoare_conseq1 1);
1910
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
   108
  by (Fast_tac 2);
2055
cc274e47f607 Ran expandshort
paulson
parents: 2031
diff changeset
   109
 by (safe_tac HOL_cs);
5301
e24d15594edd streamlined proofs with new hoare_conseq1, hoare_conseq2
oheimb
parents: 5278
diff changeset
   110
 by (ALLGOALS (EVERY'[rotate_tac ~1, Asm_full_simp_tac]));
2810
c4e16b36bc57 Added wp_while.
nipkow
parents: 2055
diff changeset
   111
qed_spec_mp "wp_is_pre";
1481
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
   112
5117
7b5efef2ca74 Removed leading !! in goals.
nipkow
parents: 5069
diff changeset
   113
Goal "|= {P}c{Q} ==> |- {P}c{Q}";
5301
e24d15594edd streamlined proofs with new hoare_conseq1, hoare_conseq2
oheimb
parents: 5278
diff changeset
   114
by (rtac (wp_is_pre RSN (2,hoare_conseq1)) 1);
2810
c4e16b36bc57 Added wp_while.
nipkow
parents: 2055
diff changeset
   115
by (rewrite_goals_tac [hoare_valid_def,wp_def]);
1910
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
   116
by (Fast_tac 1);
1481
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
   117
qed "hoare_relative_complete";