src/HOL/IMP/Hoare.ML
author paulson
Mon, 07 Oct 1996 10:26:00 +0200
changeset 2055 cc274e47f607
parent 2031 03a843f0f447
child 2810 c4e16b36bc57
permissions -rw-r--r--
Ran expandshort
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
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    10
open Hoare;
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    11
1730
1c7f793fc374 Updated for new form of induction rules
paulson
parents: 1696
diff changeset
    12
goalw Hoare.thy [hoare_valid_def] "!!P c Q. |- {P}c{Q} ==> |= {P}c{Q}";
1c7f793fc374 Updated for new form of induction rules
paulson
parents: 1696
diff changeset
    13
by (etac hoare.induct 1);
2055
cc274e47f607 Ran expandshort
paulson
parents: 2031
diff changeset
    14
    by (ALLGOALS Asm_simp_tac);
1973
8c94c9a5be10 Converted proofs to use default clasets.
nipkow
parents: 1910
diff changeset
    15
  by (Fast_tac 1);
1910
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    16
 by (Fast_tac 1);
1465
5d7a7e439cec expanded tabs
clasohm
parents: 1447
diff changeset
    17
by (rtac allI 1);
5d7a7e439cec expanded tabs
clasohm
parents: 1447
diff changeset
    18
by (rtac allI 1);
5d7a7e439cec expanded tabs
clasohm
parents: 1447
diff changeset
    19
by (rtac impI 1);
5d7a7e439cec expanded tabs
clasohm
parents: 1447
diff changeset
    20
by (etac induct2 1);
2055
cc274e47f607 Ran expandshort
paulson
parents: 2031
diff changeset
    21
 by (rtac Gamma_mono 1);
1465
5d7a7e439cec expanded tabs
clasohm
parents: 1447
diff changeset
    22
by (rewtac Gamma_def);  
1973
8c94c9a5be10 Converted proofs to use default clasets.
nipkow
parents: 1910
diff changeset
    23
by (Fast_tac 1);
1730
1c7f793fc374 Updated for new form of induction rules
paulson
parents: 1696
diff changeset
    24
qed "hoare_sound";
936
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    25
1696
e84bff5c519b A completely new version of IMP.
nipkow
parents: 1486
diff changeset
    26
goalw Hoare.thy [swp_def] "swp SKIP Q = Q";
2031
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    27
by (Simp_tac 1);
1696
e84bff5c519b A completely new version of IMP.
nipkow
parents: 1486
diff changeset
    28
qed "swp_SKIP";
1481
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
    29
1696
e84bff5c519b A completely new version of IMP.
nipkow
parents: 1486
diff changeset
    30
goalw Hoare.thy [swp_def] "swp (x:=a) Q = (%s.Q(s[a s/x]))";
2031
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    31
by (Simp_tac 1);
1481
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
    32
qed "swp_Ass";
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
    33
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
    34
goalw Hoare.thy [swp_def] "swp (c;d) Q = swp c (swp d Q)";
2031
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    35
by (Simp_tac 1);
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    36
by (rtac ext 1);
1910
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    37
by (Fast_tac 1);
1481
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
    38
qed "swp_Semi";
936
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    39
1481
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
    40
goalw Hoare.thy [swp_def]
1696
e84bff5c519b A completely new version of IMP.
nipkow
parents: 1486
diff changeset
    41
  "swp (IF b THEN c ELSE d) Q = (%s. (b s --> swp c Q s) & \
e84bff5c519b A completely new version of IMP.
nipkow
parents: 1486
diff changeset
    42
\                                    (~b s --> swp d Q s))";
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);
1481
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
    46
qed "swp_If";
936
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    47
1481
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
    48
goalw Hoare.thy [swp_def]
1696
e84bff5c519b A completely new version of IMP.
nipkow
parents: 1486
diff changeset
    49
  "!!s. b s ==> swp (WHILE b DO c) Q s = swp (c;WHILE b DO c) Q s";
2031
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    50
by (stac C_While_If 1);
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    51
by (Asm_simp_tac 1);
1481
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
    52
qed "swp_While_True";
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
    53
1696
e84bff5c519b A completely new version of IMP.
nipkow
parents: 1486
diff changeset
    54
goalw Hoare.thy [swp_def] "!!s. ~b s ==> swp (WHILE b DO c) Q s = Q s";
2031
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    55
by (stac C_While_If 1);
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    56
by (Asm_simp_tac 1);
1481
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
    57
qed "swp_While_False";
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
    58
1696
e84bff5c519b A completely new version of IMP.
nipkow
parents: 1486
diff changeset
    59
Addsimps [swp_SKIP,swp_Ass,swp_Semi,swp_If,swp_While_True,swp_While_False];
1481
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
    60
1910
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    61
(*Not suitable for rewriting: LOOPS!*)
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    62
goal Hoare.thy "swp (WHILE b DO c) Q s = \
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    63
\                 (if b s then swp (c;WHILE b DO c) Q s else Q s)";
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    64
by (simp_tac (!simpset setloop split_tac [expand_if]) 1);
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    65
qed "swp_While_if";
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    66
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    67
1481
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
    68
Delsimps [C_while];
936
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    69
1910
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    70
AddSIs [hoare.skip, hoare.ass, hoare.semi, hoare.If];
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    71
1486
7b95d7b49f7a Introduced qed_spec_mp.
nipkow
parents: 1481
diff changeset
    72
goal Hoare.thy "!Q. |- {swp c Q} c {Q}";
2031
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    73
by (com.induct_tac "c" 1);
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    74
by (ALLGOALS Simp_tac);
1910
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    75
by (REPEAT_FIRST Fast_tac);
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    76
by (deepen_tac (!claset addIs [hoare.conseq]) 0 1);
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    77
by (Step_tac 1);
2031
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    78
by (rtac hoare.conseq 1);
2055
cc274e47f607 Ran expandshort
paulson
parents: 2031
diff changeset
    79
  by (etac thin_rl 1);
1910
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    80
  by (Fast_tac 1);
2055
cc274e47f607 Ran expandshort
paulson
parents: 2031
diff changeset
    81
 by (rtac hoare.While 1);
cc274e47f607 Ran expandshort
paulson
parents: 2031
diff changeset
    82
 by (rtac hoare.conseq 1);
cc274e47f607 Ran expandshort
paulson
parents: 2031
diff changeset
    83
   by (etac thin_rl 3);
cc274e47f607 Ran expandshort
paulson
parents: 2031
diff changeset
    84
   by (rtac allI 3);
cc274e47f607 Ran expandshort
paulson
parents: 2031
diff changeset
    85
   by (rtac impI 3);
cc274e47f607 Ran expandshort
paulson
parents: 2031
diff changeset
    86
   by (assume_tac 3);
1910
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    87
  by (Fast_tac 2);
2055
cc274e47f607 Ran expandshort
paulson
parents: 2031
diff changeset
    88
 by (safe_tac HOL_cs);
cc274e47f607 Ran expandshort
paulson
parents: 2031
diff changeset
    89
 by (rotate_tac ~1 1);
cc274e47f607 Ran expandshort
paulson
parents: 2031
diff changeset
    90
 by (Asm_full_simp_tac 1);
2031
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    91
by (rotate_tac ~1 1);
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    92
by (Asm_full_simp_tac 1);
1486
7b95d7b49f7a Introduced qed_spec_mp.
nipkow
parents: 1481
diff changeset
    93
qed_spec_mp "swp_is_pre";
1481
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
    94
1486
7b95d7b49f7a Introduced qed_spec_mp.
nipkow
parents: 1481
diff changeset
    95
goal Hoare.thy "!!c. |= {P}c{Q} ==> |- {P}c{Q}";
2031
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    96
by (rtac (swp_is_pre RSN (2,hoare.conseq)) 1);
1910
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    97
 by (Fast_tac 2);
2031
03a843f0f447 Ran expandshort
paulson
parents: 1973
diff changeset
    98
by (rewrite_goals_tac [hoare_valid_def,swp_def]);
1910
6d572f96fb76 Tidied some proofs, maybe using less_SucE
paulson
parents: 1747
diff changeset
    99
by (Fast_tac 1);
1481
03f096efa26d Modified datatype com.
nipkow
parents: 1465
diff changeset
   100
qed "hoare_relative_complete";