src/HOL/IMP/VC.thy
author nipkow
Fri Aug 28 18:52:41 2009 +0200 (2009-08-28)
changeset 32436 10cd49e0c067
parent 27362 a6dc1769fdda
child 35754 8e7dba5f00f5
permissions -rw-r--r--
Turned "x <= y ==> sup x y = y" (and relatives) into simp rules
clasohm@1476
     1
(*  Title:      HOL/IMP/VC.thy
nipkow@1447
     2
    ID:         $Id$
clasohm@1476
     3
    Author:     Tobias Nipkow
nipkow@1447
     4
    Copyright   1996 TUM
nipkow@1447
     5
nipkow@1447
     6
acom: annotated commands
nipkow@1447
     7
vc:   verification-conditions
nipkow@2810
     8
awp:   weakest (liberal) precondition
nipkow@1447
     9
*)
nipkow@1447
    10
kleing@12431
    11
header "Verification Conditions"
kleing@12431
    12
haftmann@16417
    13
theory VC imports Hoare begin
nipkow@1447
    14
nipkow@1447
    15
datatype  acom = Askip
nipkow@1447
    16
               | Aass   loc aexp
nipkow@1447
    17
               | Asemi  acom acom
nipkow@1447
    18
               | Aif    bexp acom acom
nipkow@1447
    19
               | Awhile bexp assn acom
nipkow@1447
    20
wenzelm@27362
    21
primrec awp :: "acom => assn => assn"
wenzelm@27362
    22
where
nipkow@2810
    23
  "awp Askip Q = Q"
wenzelm@27362
    24
| "awp (Aass x a) Q = (\<lambda>s. Q(s[x\<mapsto>a s]))"
wenzelm@27362
    25
| "awp (Asemi c d) Q = awp c (awp d Q)"
wenzelm@27362
    26
| "awp (Aif b c d) Q = (\<lambda>s. (b s-->awp c Q s) & (~b s-->awp d Q s))"
wenzelm@27362
    27
| "awp (Awhile b I c) Q = I"
nipkow@1447
    28
wenzelm@27362
    29
primrec vc :: "acom => assn => assn"
wenzelm@27362
    30
where
kleing@12431
    31
  "vc Askip Q = (\<lambda>s. True)"
wenzelm@27362
    32
| "vc (Aass x a) Q = (\<lambda>s. True)"
wenzelm@27362
    33
| "vc (Asemi c d) Q = (\<lambda>s. vc c (awp d Q) s & vc d Q s)"
wenzelm@27362
    34
| "vc (Aif b c d) Q = (\<lambda>s. vc c Q s & vc d Q s)"
wenzelm@27362
    35
| "vc (Awhile b I c) Q = (\<lambda>s. (I s & ~b s --> Q s) &
nipkow@2810
    36
                              (I s & b s --> awp c I s) & vc c I s)"
nipkow@1447
    37
wenzelm@27362
    38
primrec astrip :: "acom => com"
wenzelm@27362
    39
where
berghofe@1900
    40
  "astrip Askip = SKIP"
wenzelm@27362
    41
| "astrip (Aass x a) = (x:==a)"
wenzelm@27362
    42
| "astrip (Asemi c d) = (astrip c;astrip d)"
wenzelm@27362
    43
| "astrip (Aif b c d) = (\<IF> b \<THEN> astrip c \<ELSE> astrip d)"
wenzelm@27362
    44
| "astrip (Awhile b I c) = (\<WHILE> b \<DO> astrip c)"
nipkow@1451
    45
nipkow@2810
    46
(* simultaneous computation of vc and awp: *)
wenzelm@27362
    47
primrec vcawp :: "acom => assn => assn \<times> assn"
wenzelm@27362
    48
where
kleing@12431
    49
  "vcawp Askip Q = (\<lambda>s. True, Q)"
wenzelm@27362
    50
| "vcawp (Aass x a) Q = (\<lambda>s. True, \<lambda>s. Q(s[x\<mapsto>a s]))"
wenzelm@27362
    51
| "vcawp (Asemi c d) Q = (let (vcd,wpd) = vcawp d Q;
nipkow@2810
    52
                              (vcc,wpc) = vcawp c wpd
kleing@12431
    53
                          in (\<lambda>s. vcc s & vcd s, wpc))"
wenzelm@27362
    54
| "vcawp (Aif b c d) Q = (let (vcd,wpd) = vcawp d Q;
nipkow@2810
    55
                              (vcc,wpc) = vcawp c Q
kleing@12431
    56
                          in (\<lambda>s. vcc s & vcd s,
kleing@12431
    57
                              \<lambda>s.(b s --> wpc s) & (~b s --> wpd s)))"
wenzelm@27362
    58
| "vcawp (Awhile b I c) Q = (let (vcc,wpc) = vcawp c I
kleing@12431
    59
                             in (\<lambda>s. (I s & ~b s --> Q s) &
nipkow@2810
    60
                                     (I s & b s --> wpc s) & vcc s, I))"
nipkow@1451
    61
kleing@12431
    62
(*
kleing@12431
    63
Soundness and completeness of vc
kleing@12431
    64
*)
kleing@12431
    65
kleing@12431
    66
declare hoare.intros [intro]
kleing@12431
    67
kleing@12431
    68
lemma l: "!s. P s --> P s" by fast
kleing@12431
    69
wenzelm@18372
    70
lemma vc_sound: "(!s. vc c Q s) --> |- {awp c Q} astrip c {Q}"
wenzelm@20503
    71
apply (induct c arbitrary: Q)
kleing@12431
    72
    apply (simp_all (no_asm))
kleing@12431
    73
    apply fast
kleing@12431
    74
   apply fast
kleing@12431
    75
  apply fast
kleing@12431
    76
 (* if *)
wenzelm@18372
    77
 apply atomize
wenzelm@26342
    78
 apply (tactic "deepen_tac @{claset} 4 1")
kleing@12431
    79
(* while *)
wenzelm@18372
    80
apply atomize
wenzelm@18372
    81
apply (intro allI impI)
kleing@12431
    82
apply (rule conseq)
kleing@12431
    83
  apply (rule l)
kleing@12431
    84
 apply (rule While)
kleing@12431
    85
 defer
kleing@12431
    86
 apply fast
wenzelm@18372
    87
apply (rule_tac P="awp c fun2" in conseq)
kleing@12431
    88
  apply fast
kleing@12431
    89
 apply fast
kleing@12431
    90
apply fast
kleing@12431
    91
done
kleing@12431
    92
wenzelm@18372
    93
lemma awp_mono [rule_format (no_asm)]:
kleing@12434
    94
  "!P Q. (!s. P s --> Q s) --> (!s. awp c P s --> awp c Q s)"
wenzelm@18372
    95
apply (induct c)
kleing@12431
    96
    apply (simp_all (no_asm_simp))
kleing@12431
    97
apply (rule allI, rule allI, rule impI)
kleing@12431
    98
apply (erule allE, erule allE, erule mp)
kleing@12431
    99
apply (erule allE, erule allE, erule mp, assumption)
kleing@12431
   100
done
kleing@12431
   101
wenzelm@18372
   102
lemma vc_mono [rule_format (no_asm)]:
kleing@12434
   103
  "!P Q. (!s. P s --> Q s) --> (!s. vc c P s --> vc c Q s)"
wenzelm@18372
   104
apply (induct c)
kleing@12431
   105
    apply (simp_all (no_asm_simp))
kleing@12431
   106
apply safe
wenzelm@18372
   107
apply (erule allE,erule allE,erule impE,erule_tac [2] allE,erule_tac [2] mp)
kleing@12431
   108
prefer 2 apply assumption
kleing@12431
   109
apply (fast elim: awp_mono)
kleing@12431
   110
done
kleing@12431
   111
nipkow@13596
   112
lemma vc_complete: assumes der: "|- {P}c{Q}"
wenzelm@18372
   113
  shows "(\<exists>ac. astrip ac = c & (\<forall>s. vc ac Q s) & (\<forall>s. P s --> awp ac Q s))"
nipkow@13596
   114
  (is "? ac. ?Eq P c Q ac")
nipkow@13596
   115
using der
nipkow@13596
   116
proof induct
nipkow@13596
   117
  case skip
nipkow@13596
   118
  show ?case (is "? ac. ?C ac")
nipkow@13596
   119
  proof show "?C Askip" by simp qed
nipkow@13596
   120
next
berghofe@23746
   121
  case (ass P x a)
nipkow@13596
   122
  show ?case (is "? ac. ?C ac")
nipkow@13596
   123
  proof show "?C(Aass x a)" by simp qed
nipkow@13596
   124
next
berghofe@23746
   125
  case (semi P c1 Q c2 R)
nipkow@13596
   126
  from semi.hyps obtain ac1 where ih1: "?Eq P c1 Q ac1" by fast
nipkow@13596
   127
  from semi.hyps obtain ac2 where ih2: "?Eq Q c2 R ac2" by fast
nipkow@13596
   128
  show ?case (is "? ac. ?C ac")
nipkow@13596
   129
  proof
nipkow@13596
   130
    show "?C(Asemi ac1 ac2)"
nipkow@13596
   131
      using ih1 ih2 by simp (fast elim!: awp_mono vc_mono)
nipkow@13596
   132
  qed
nipkow@13596
   133
next
berghofe@23746
   134
  case (If P b c1 Q c2)
nipkow@13596
   135
  from If.hyps obtain ac1 where ih1: "?Eq (%s. P s & b s) c1 Q ac1" by fast
nipkow@13596
   136
  from If.hyps obtain ac2 where ih2: "?Eq (%s. P s & ~b s) c2 Q ac2" by fast
nipkow@13596
   137
  show ?case (is "? ac. ?C ac")
nipkow@13596
   138
  proof
nipkow@13596
   139
    show "?C(Aif b ac1 ac2)"
nipkow@13596
   140
      using ih1 ih2 by simp
nipkow@13596
   141
  qed
nipkow@13596
   142
next
nipkow@13596
   143
  case (While P b c)
nipkow@13596
   144
  from While.hyps obtain ac where ih: "?Eq (%s. P s & b s) c P ac" by fast
nipkow@13596
   145
  show ?case (is "? ac. ?C ac")
nipkow@13596
   146
  proof show "?C(Awhile b P ac)" using ih by simp qed
nipkow@13596
   147
next
nipkow@13596
   148
  case conseq thus ?case by(fast elim!: awp_mono vc_mono)
nipkow@13596
   149
qed
kleing@12431
   150
wenzelm@18372
   151
lemma vcawp_vc_awp: "vcawp c Q = (vc c Q, awp c Q)"
wenzelm@20503
   152
  by (induct c arbitrary: Q) (simp_all add: Let_def)
kleing@12431
   153
nipkow@1447
   154
end