src/HOL/IMPP/Hoare.thy
author bulwahn
Fri Oct 21 11:17:14 2011 +0200 (2011-10-21)
changeset 45231 d85a2fdc586c
parent 42793 88bee9f6eec7
child 45605 a89b4bc311a5
permissions -rw-r--r--
replacing code_inline by code_unfold, removing obsolete code_unfold, code_inline del now that the ancient code generator is removed
oheimb@8177
     1
(*  Title:      HOL/IMPP/Hoare.thy
oheimb@8177
     2
    Author:     David von Oheimb
oheimb@8177
     3
    Copyright   1999 TUM
oheimb@8177
     4
*)
oheimb@8177
     5
wenzelm@17477
     6
header {* Inductive definition of Hoare logic for partial correctness *}
wenzelm@17477
     7
wenzelm@17477
     8
theory Hoare
wenzelm@17477
     9
imports Natural
wenzelm@17477
    10
begin
wenzelm@17477
    11
wenzelm@17477
    12
text {*
wenzelm@17477
    13
  Completeness is taken relative to completeness of the underlying logic.
wenzelm@17477
    14
wenzelm@17477
    15
  Two versions of completeness proof: nested single recursion
wenzelm@17477
    16
  vs. simultaneous recursion in call rule
wenzelm@17477
    17
*}
oheimb@8177
    18
wenzelm@42174
    19
type_synonym 'a assn = "'a => state => bool"
oheimb@8177
    20
translations
wenzelm@35431
    21
  (type) "'a assn" <= (type) "'a => state => bool"
oheimb@8177
    22
wenzelm@27364
    23
definition
wenzelm@27364
    24
  state_not_singleton :: bool where
wenzelm@27364
    25
  "state_not_singleton = (\<exists>s t::state. s ~= t)" (* at least two elements *)
oheimb@8177
    26
wenzelm@27364
    27
definition
wenzelm@27364
    28
  peek_and :: "'a assn => (state => bool) => 'a assn" (infixr "&>" 35) where
wenzelm@27364
    29
  "peek_and P p = (%Z s. P Z s & p s)"
oheimb@8177
    30
oheimb@8177
    31
datatype 'a triple =
wenzelm@17477
    32
  triple "'a assn"  com  "'a assn"       ("{(1_)}./ (_)/ .{(1_)}" [3,60,3] 58)
wenzelm@17477
    33
wenzelm@27364
    34
definition
wenzelm@27364
    35
  triple_valid :: "nat => 'a triple     => bool" ( "|=_:_" [0 , 58] 57) where
wenzelm@27364
    36
  "|=n:t = (case t of {P}.c.{Q} =>
wenzelm@27364
    37
             !Z s. P Z s --> (!s'. <c,s> -n-> s' --> Q Z s'))"
wenzelm@27364
    38
abbreviation
wenzelm@27364
    39
  triples_valid :: "nat => 'a triple set => bool" ("||=_:_" [0 , 58] 57) where
wenzelm@27364
    40
  "||=n:G == Ball G (triple_valid n)"
oheimb@8177
    41
wenzelm@27364
    42
definition
wenzelm@27364
    43
  hoare_valids :: "'a triple set => 'a triple set => bool" ("_||=_"  [58, 58] 57) where
wenzelm@27364
    44
  "G||=ts = (!n. ||=n:G --> ||=n:ts)"
wenzelm@27364
    45
abbreviation
wenzelm@27364
    46
  hoare_valid :: "'a triple set => 'a triple     => bool" ("_|=_"   [58, 58] 57) where
wenzelm@27364
    47
  "G |=t == G||={t}"
oheimb@8177
    48
oheimb@8177
    49
(* Most General Triples *)
wenzelm@27364
    50
definition
wenzelm@27364
    51
  MGT :: "com => state triple"            ("{=}._.{->}" [60] 58) where
wenzelm@27364
    52
  "{=}.c.{->} = {%Z s0. Z = s0}. c .{%Z s1. <c,Z> -c-> s1}"
oheimb@8177
    53
berghofe@23746
    54
inductive
wenzelm@27364
    55
  hoare_derivs :: "'a triple set => 'a triple set => bool" ("_||-_"  [58, 58] 57) and
wenzelm@27364
    56
  hoare_deriv :: "'a triple set => 'a triple     => bool" ("_|-_"   [58, 58] 57)
berghofe@23746
    57
where
berghofe@23746
    58
  "G |-t == G||-{t}"
wenzelm@17477
    59
berghofe@23746
    60
| empty:    "G||-{}"
berghofe@23746
    61
| insert: "[| G |-t;  G||-ts |]
wenzelm@17477
    62
        ==> G||-insert t ts"
oheimb@8177
    63
berghofe@23746
    64
| asm:      "ts <= G ==>
wenzelm@17477
    65
             G||-ts" (* {P}.BODY pn.{Q} instead of (general) t for SkipD_lemma *)
oheimb@8177
    66
berghofe@23746
    67
| cut:   "[| G'||-ts; G||-G' |] ==> G||-ts" (* for convenience and efficiency *)
oheimb@8177
    68
berghofe@23746
    69
| weaken: "[| G||-ts' ; ts <= ts' |] ==> G||-ts"
oheimb@8177
    70
berghofe@23746
    71
| conseq: "!Z s. P  Z  s --> (? P' Q'. G|-{P'}.c.{Q'} &
wenzelm@17477
    72
                                   (!s'. (!Z'. P' Z' s --> Q' Z' s') --> Q Z s'))
wenzelm@17477
    73
          ==> G|-{P}.c.{Q}"
oheimb@8177
    74
oheimb@8177
    75
berghofe@23746
    76
| Skip:  "G|-{P}. SKIP .{P}"
oheimb@8177
    77
berghofe@23746
    78
| Ass:   "G|-{%Z s. P Z (s[X::=a s])}. X:==a .{P}"
oheimb@8177
    79
berghofe@23746
    80
| Local: "G|-{P}. c .{%Z s. Q Z (s[Loc X::=s'<X>])}
wenzelm@17477
    81
      ==> G|-{%Z s. s'=s & P Z (s[Loc X::=a s])}. LOCAL X:=a IN c .{Q}"
oheimb@8177
    82
berghofe@23746
    83
| Comp:  "[| G|-{P}.c.{Q};
wenzelm@17477
    84
             G|-{Q}.d.{R} |]
wenzelm@17477
    85
         ==> G|-{P}. (c;;d) .{R}"
oheimb@8177
    86
berghofe@23746
    87
| If:    "[| G|-{P &>        b }.c.{Q};
wenzelm@17477
    88
             G|-{P &> (Not o b)}.d.{Q} |]
wenzelm@17477
    89
         ==> G|-{P}. IF b THEN c ELSE d .{Q}"
oheimb@8177
    90
berghofe@23746
    91
| Loop:  "G|-{P &> b}.c.{P} ==>
wenzelm@17477
    92
          G|-{P}. WHILE b DO c .{P &> (Not o b)}"
oheimb@8177
    93
oheimb@8177
    94
(*
wenzelm@17477
    95
  BodyN: "(insert ({P}. BODY pn  .{Q}) G)
wenzelm@17477
    96
           |-{P}.  the (body pn) .{Q} ==>
wenzelm@17477
    97
          G|-{P}.       BODY pn  .{Q}"
oheimb@8177
    98
*)
berghofe@23746
    99
| Body:  "[| G Un (%p. {P p}.      BODY p  .{Q p})`Procs
wenzelm@17477
   100
               ||-(%p. {P p}. the (body p) .{Q p})`Procs |]
wenzelm@17477
   101
         ==>  G||-(%p. {P p}.      BODY p  .{Q p})`Procs"
oheimb@8177
   102
berghofe@23746
   103
| Call:     "G|-{P}. BODY pn .{%Z s. Q Z (setlocs s (getlocs s')[X::=s<Res>])}
wenzelm@17477
   104
         ==> G|-{%Z s. s'=s & P Z (setlocs s newlocs[Loc Arg::=a s])}.
wenzelm@17477
   105
             X:=CALL pn(a) .{Q}"
wenzelm@17477
   106
wenzelm@19803
   107
wenzelm@19803
   108
section {* Soundness and relative completeness of Hoare rules wrt operational semantics *}
wenzelm@19803
   109
wenzelm@19803
   110
lemma single_stateE: 
wenzelm@19803
   111
  "state_not_singleton ==> !t. (!s::state. s = t) --> False"
wenzelm@19803
   112
apply (unfold state_not_singleton_def)
wenzelm@19803
   113
apply clarify
wenzelm@19803
   114
apply (case_tac "ta = t")
wenzelm@19803
   115
apply blast
wenzelm@19803
   116
apply (blast dest: not_sym)
wenzelm@19803
   117
done
wenzelm@19803
   118
wenzelm@19803
   119
declare peek_and_def [simp]
wenzelm@19803
   120
wenzelm@19803
   121
wenzelm@19803
   122
subsection "validity"
wenzelm@19803
   123
wenzelm@19803
   124
lemma triple_valid_def2: 
wenzelm@19803
   125
  "|=n:{P}.c.{Q} = (!Z s. P Z s --> (!s'. <c,s> -n-> s' --> Q Z s'))"
wenzelm@19803
   126
apply (unfold triple_valid_def)
wenzelm@19803
   127
apply auto
wenzelm@19803
   128
done
wenzelm@19803
   129
wenzelm@19803
   130
lemma Body_triple_valid_0: "|=0:{P}. BODY pn .{Q}"
wenzelm@19803
   131
apply (simp (no_asm) add: triple_valid_def2)
wenzelm@19803
   132
apply clarsimp
wenzelm@19803
   133
done
wenzelm@19803
   134
wenzelm@19803
   135
(* only ==> direction required *)
wenzelm@19803
   136
lemma Body_triple_valid_Suc: "|=n:{P}. the (body pn) .{Q} = |=Suc n:{P}. BODY pn .{Q}"
wenzelm@19803
   137
apply (simp (no_asm) add: triple_valid_def2)
wenzelm@19803
   138
apply force
wenzelm@19803
   139
done
wenzelm@19803
   140
wenzelm@19803
   141
lemma triple_valid_Suc [rule_format (no_asm)]: "|=Suc n:t --> |=n:t"
wenzelm@19803
   142
apply (unfold triple_valid_def)
wenzelm@19803
   143
apply (induct_tac t)
wenzelm@19803
   144
apply simp
wenzelm@19803
   145
apply (fast intro: evaln_Suc)
wenzelm@19803
   146
done
wenzelm@19803
   147
wenzelm@19803
   148
lemma triples_valid_Suc: "||=Suc n:ts ==> ||=n:ts"
wenzelm@19803
   149
apply (fast intro: triple_valid_Suc)
wenzelm@19803
   150
done
wenzelm@19803
   151
wenzelm@19803
   152
wenzelm@19803
   153
subsection "derived rules"
wenzelm@19803
   154
wenzelm@19803
   155
lemma conseq12: "[| G|-{P'}.c.{Q'}; !Z s. P Z s -->  
wenzelm@19803
   156
                         (!s'. (!Z'. P' Z' s --> Q' Z' s') --> Q Z s') |]  
wenzelm@19803
   157
       ==> G|-{P}.c.{Q}"
wenzelm@19803
   158
apply (rule hoare_derivs.conseq)
wenzelm@19803
   159
apply blast
wenzelm@19803
   160
done
wenzelm@19803
   161
wenzelm@19803
   162
lemma conseq1: "[| G|-{P'}.c.{Q}; !Z s. P Z s --> P' Z s |] ==> G|-{P}.c.{Q}"
wenzelm@19803
   163
apply (erule conseq12)
wenzelm@19803
   164
apply fast
wenzelm@19803
   165
done
wenzelm@19803
   166
wenzelm@19803
   167
lemma conseq2: "[| G|-{P}.c.{Q'}; !Z s. Q' Z s --> Q Z s |] ==> G|-{P}.c.{Q}"
wenzelm@19803
   168
apply (erule conseq12)
wenzelm@19803
   169
apply fast
wenzelm@19803
   170
done
wenzelm@19803
   171
wenzelm@19803
   172
lemma Body1: "[| G Un (%p. {P p}.      BODY p  .{Q p})`Procs   
wenzelm@19803
   173
          ||- (%p. {P p}. the (body p) .{Q p})`Procs;  
wenzelm@19803
   174
    pn:Procs |] ==> G|-{P pn}. BODY pn .{Q pn}"
wenzelm@19803
   175
apply (drule hoare_derivs.Body)
wenzelm@19803
   176
apply (erule hoare_derivs.weaken)
wenzelm@19803
   177
apply fast
wenzelm@19803
   178
done
wenzelm@19803
   179
wenzelm@19803
   180
lemma BodyN: "(insert ({P}. BODY pn .{Q}) G) |-{P}. the (body pn) .{Q} ==>  
wenzelm@19803
   181
  G|-{P}. BODY pn .{Q}"
wenzelm@19803
   182
apply (rule Body1)
wenzelm@19803
   183
apply (rule_tac [2] singletonI)
wenzelm@19803
   184
apply clarsimp
wenzelm@19803
   185
done
wenzelm@19803
   186
wenzelm@19803
   187
lemma escape: "[| !Z s. P Z s --> G|-{%Z s'. s'=s}.c.{%Z'. Q Z} |] ==> G|-{P}.c.{Q}"
wenzelm@19803
   188
apply (rule hoare_derivs.conseq)
wenzelm@19803
   189
apply fast
wenzelm@19803
   190
done
wenzelm@19803
   191
wenzelm@19803
   192
lemma constant: "[| C ==> G|-{P}.c.{Q} |] ==> G|-{%Z s. P Z s & C}.c.{Q}"
wenzelm@19803
   193
apply (rule hoare_derivs.conseq)
wenzelm@19803
   194
apply fast
wenzelm@19803
   195
done
wenzelm@19803
   196
wenzelm@19803
   197
lemma LoopF: "G|-{%Z s. P Z s & ~b s}.WHILE b DO c.{P}"
wenzelm@19803
   198
apply (rule hoare_derivs.Loop [THEN conseq2])
wenzelm@19803
   199
apply  (simp_all (no_asm))
wenzelm@19803
   200
apply (rule hoare_derivs.conseq)
wenzelm@19803
   201
apply fast
wenzelm@19803
   202
done
wenzelm@19803
   203
wenzelm@19803
   204
(*
wenzelm@19803
   205
Goal "[| G'||-ts; G' <= G |] ==> G||-ts"
wenzelm@19803
   206
by (etac hoare_derivs.cut 1);
wenzelm@19803
   207
by (etac hoare_derivs.asm 1);
wenzelm@19803
   208
qed "thin";
wenzelm@19803
   209
*)
wenzelm@19803
   210
lemma thin [rule_format]: "G'||-ts ==> !G. G' <= G --> G||-ts"
wenzelm@19803
   211
apply (erule hoare_derivs.induct)
wenzelm@42793
   212
apply                (tactic {* ALLGOALS (EVERY'[clarify_tac @{context}, REPEAT o smp_tac 1]) *})
wenzelm@19803
   213
apply (rule hoare_derivs.empty)
wenzelm@19803
   214
apply               (erule (1) hoare_derivs.insert)
wenzelm@19803
   215
apply              (fast intro: hoare_derivs.asm)
wenzelm@19803
   216
apply             (fast intro: hoare_derivs.cut)
wenzelm@19803
   217
apply            (fast intro: hoare_derivs.weaken)
wenzelm@19803
   218
apply           (rule hoare_derivs.conseq, intro strip, tactic "smp_tac 2 1", clarify, tactic "smp_tac 1 1",rule exI, rule exI, erule (1) conjI)
wenzelm@19803
   219
prefer 7
wenzelm@19803
   220
apply          (rule_tac hoare_derivs.Body, drule_tac spec, erule_tac mp, fast)
wenzelm@42793
   221
apply         (tactic {* ALLGOALS (resolve_tac ((funpow 5 tl) @{thms hoare_derivs.intros}) THEN_ALL_NEW (fast_tac @{context})) *})
wenzelm@19803
   222
done
wenzelm@19803
   223
wenzelm@19803
   224
lemma weak_Body: "G|-{P}. the (body pn) .{Q} ==> G|-{P}. BODY pn .{Q}"
wenzelm@19803
   225
apply (rule BodyN)
wenzelm@19803
   226
apply (erule thin)
wenzelm@19803
   227
apply auto
wenzelm@19803
   228
done
wenzelm@19803
   229
wenzelm@19803
   230
lemma derivs_insertD: "G||-insert t ts ==> G|-t & G||-ts"
wenzelm@19803
   231
apply (fast intro: hoare_derivs.weaken)
wenzelm@19803
   232
done
wenzelm@19803
   233
wenzelm@19803
   234
lemma finite_pointwise [rule_format (no_asm)]: "[| finite U;  
wenzelm@19803
   235
  !p. G |-     {P' p}.c0 p.{Q' p}       --> G |-     {P p}.c0 p.{Q p} |] ==>  
wenzelm@19803
   236
      G||-(%p. {P' p}.c0 p.{Q' p}) ` U --> G||-(%p. {P p}.c0 p.{Q p}) ` U"
wenzelm@19803
   237
apply (erule finite_induct)
wenzelm@19803
   238
apply simp
wenzelm@19803
   239
apply clarsimp
wenzelm@19803
   240
apply (drule derivs_insertD)
wenzelm@19803
   241
apply (rule hoare_derivs.insert)
wenzelm@19803
   242
apply  auto
wenzelm@19803
   243
done
wenzelm@19803
   244
wenzelm@19803
   245
wenzelm@19803
   246
subsection "soundness"
wenzelm@19803
   247
wenzelm@19803
   248
lemma Loop_sound_lemma: 
wenzelm@19803
   249
 "G|={P &> b}. c .{P} ==>  
wenzelm@19803
   250
  G|={P}. WHILE b DO c .{P &> (Not o b)}"
wenzelm@19803
   251
apply (unfold hoare_valids_def)
wenzelm@19803
   252
apply (simp (no_asm_use) add: triple_valid_def2)
wenzelm@19803
   253
apply (rule allI)
wenzelm@19803
   254
apply (subgoal_tac "!d s s'. <d,s> -n-> s' --> d = WHILE b DO c --> ||=n:G --> (!Z. P Z s --> P Z s' & ~b s') ")
wenzelm@19803
   255
apply  (erule thin_rl, fast)
wenzelm@19803
   256
apply ((rule allI)+, rule impI)
wenzelm@19803
   257
apply (erule evaln.induct)
wenzelm@19803
   258
apply (simp_all (no_asm))
wenzelm@19803
   259
apply fast
wenzelm@19803
   260
apply fast
wenzelm@19803
   261
done
wenzelm@19803
   262
wenzelm@19803
   263
lemma Body_sound_lemma: 
wenzelm@19803
   264
   "[| G Un (%pn. {P pn}.      BODY pn  .{Q pn})`Procs  
wenzelm@19803
   265
         ||=(%pn. {P pn}. the (body pn) .{Q pn})`Procs |] ==>  
wenzelm@19803
   266
        G||=(%pn. {P pn}.      BODY pn  .{Q pn})`Procs"
wenzelm@19803
   267
apply (unfold hoare_valids_def)
wenzelm@19803
   268
apply (rule allI)
wenzelm@19803
   269
apply (induct_tac n)
wenzelm@19803
   270
apply  (fast intro: Body_triple_valid_0)
wenzelm@19803
   271
apply clarsimp
wenzelm@19803
   272
apply (drule triples_valid_Suc)
wenzelm@19803
   273
apply (erule (1) notE impE)
wenzelm@19803
   274
apply (simp add: ball_Un)
wenzelm@19803
   275
apply (drule spec, erule impE, erule conjI, assumption)
wenzelm@19803
   276
apply (fast intro!: Body_triple_valid_Suc [THEN iffD1])
wenzelm@19803
   277
done
wenzelm@19803
   278
wenzelm@19803
   279
lemma hoare_sound: "G||-ts ==> G||=ts"
wenzelm@19803
   280
apply (erule hoare_derivs.induct)
wenzelm@39159
   281
apply              (tactic {* TRYALL (eresolve_tac [@{thm Loop_sound_lemma}, @{thm Body_sound_lemma}] THEN_ALL_NEW atac) *})
wenzelm@19803
   282
apply            (unfold hoare_valids_def)
wenzelm@19803
   283
apply            blast
wenzelm@19803
   284
apply           blast
wenzelm@19803
   285
apply          (blast) (* asm *)
wenzelm@19803
   286
apply         (blast) (* cut *)
wenzelm@19803
   287
apply        (blast) (* weaken *)
wenzelm@27208
   288
apply       (tactic {* ALLGOALS (EVERY'
wenzelm@27239
   289
  [REPEAT o thin_tac @{context} "hoare_derivs ?x ?y",
wenzelm@42793
   290
   simp_tac @{simpset}, clarify_tac @{context}, REPEAT o smp_tac 1]) *})
wenzelm@19803
   291
apply       (simp_all (no_asm_use) add: triple_valid_def2)
wenzelm@19803
   292
apply       (intro strip, tactic "smp_tac 2 1", blast) (* conseq *)
wenzelm@42793
   293
apply      (tactic {* ALLGOALS (clarsimp_tac @{context}) *}) (* Skip, Ass, Local *)
wenzelm@19803
   294
prefer 3 apply   (force) (* Call *)
wenzelm@19803
   295
apply  (erule_tac [2] evaln_elim_cases) (* If *)
wenzelm@19803
   296
apply   blast+
wenzelm@19803
   297
done
wenzelm@19803
   298
wenzelm@19803
   299
wenzelm@19803
   300
section "completeness"
wenzelm@19803
   301
wenzelm@19803
   302
(* Both versions *)
wenzelm@19803
   303
wenzelm@19803
   304
(*unused*)
wenzelm@19803
   305
lemma MGT_alternI: "G|-MGT c ==>  
wenzelm@19803
   306
  G|-{%Z s0. !s1. <c,s0> -c-> s1 --> Z=s1}. c .{%Z s1. Z=s1}"
wenzelm@19803
   307
apply (unfold MGT_def)
wenzelm@19803
   308
apply (erule conseq12)
wenzelm@19803
   309
apply auto
wenzelm@19803
   310
done
wenzelm@19803
   311
wenzelm@19803
   312
(* requires com_det *)
wenzelm@19803
   313
lemma MGT_alternD: "state_not_singleton ==>  
wenzelm@19803
   314
  G|-{%Z s0. !s1. <c,s0> -c-> s1 --> Z=s1}. c .{%Z s1. Z=s1} ==> G|-MGT c"
wenzelm@19803
   315
apply (unfold MGT_def)
wenzelm@19803
   316
apply (erule conseq12)
wenzelm@19803
   317
apply auto
wenzelm@19803
   318
apply (case_tac "? t. <c,?s> -c-> t")
wenzelm@19803
   319
apply  (fast elim: com_det)
wenzelm@19803
   320
apply clarsimp
wenzelm@19803
   321
apply (drule single_stateE)
wenzelm@19803
   322
apply blast
wenzelm@19803
   323
done
wenzelm@19803
   324
wenzelm@19803
   325
lemma MGF_complete: 
wenzelm@19803
   326
 "{}|-(MGT c::state triple) ==> {}|={P}.c.{Q} ==> {}|-{P}.c.{Q::state assn}"
wenzelm@19803
   327
apply (unfold MGT_def)
wenzelm@19803
   328
apply (erule conseq12)
wenzelm@19803
   329
apply (clarsimp simp add: hoare_valids_def eval_eq triple_valid_def2)
wenzelm@19803
   330
done
wenzelm@19803
   331
wenzelm@19803
   332
declare WTs_elim_cases [elim!]
wenzelm@19803
   333
declare not_None_eq [iff]
wenzelm@19803
   334
(* requires com_det, escape (i.e. hoare_derivs.conseq) *)
wenzelm@19803
   335
lemma MGF_lemma1 [rule_format (no_asm)]: "state_not_singleton ==>  
wenzelm@19803
   336
  !pn:dom body. G|-{=}.BODY pn.{->} ==> WT c --> G|-{=}.c.{->}"
wenzelm@19803
   337
apply (induct_tac c)
wenzelm@42793
   338
apply        (tactic {* ALLGOALS (clarsimp_tac @{context}) *})
wenzelm@19803
   339
prefer 7 apply        (fast intro: domI)
wenzelm@19803
   340
apply (erule_tac [6] MGT_alternD)
wenzelm@19803
   341
apply       (unfold MGT_def)
wenzelm@19803
   342
apply       (drule_tac [7] bspec, erule_tac [7] domI)
wenzelm@42793
   343
apply       (rule_tac [7] escape, tactic {* clarsimp_tac @{context} 7 *},
wenzelm@19803
   344
  rule_tac [7] P1 = "%Z' s. s= (setlocs Z newlocs) [Loc Arg ::= fun Z]" in hoare_derivs.Call [THEN conseq1], erule_tac [7] conseq12)
wenzelm@19803
   345
apply        (erule_tac [!] thin_rl)
wenzelm@19803
   346
apply (rule hoare_derivs.Skip [THEN conseq2])
wenzelm@19803
   347
apply (rule_tac [2] hoare_derivs.Ass [THEN conseq1])
wenzelm@42793
   348
apply        (rule_tac [3] escape, tactic {* clarsimp_tac @{context} 3 *},
wenzelm@19803
   349
  rule_tac [3] P1 = "%Z' s. s= (Z[Loc loc::=fun Z])" in hoare_derivs.Local [THEN conseq1],
wenzelm@19803
   350
  erule_tac [3] conseq12)
wenzelm@19803
   351
apply         (erule_tac [5] hoare_derivs.Comp, erule_tac [5] conseq12)
wenzelm@39159
   352
apply         (tactic {* (rtac @{thm hoare_derivs.If} THEN_ALL_NEW etac @{thm conseq12}) 6 *})
wenzelm@19803
   353
apply          (rule_tac [8] hoare_derivs.Loop [THEN conseq2], erule_tac [8] conseq12)
wenzelm@19803
   354
apply           auto
wenzelm@19803
   355
done
wenzelm@19803
   356
wenzelm@19803
   357
(* Version: nested single recursion *)
wenzelm@19803
   358
wenzelm@19803
   359
lemma nesting_lemma [rule_format]:
wenzelm@19803
   360
  assumes "!!G ts. ts <= G ==> P G ts"
wenzelm@19803
   361
    and "!!G pn. P (insert (mgt_call pn) G) {mgt(the(body pn))} ==> P G {mgt_call pn}"
wenzelm@19803
   362
    and "!!G c. [| wt c; !pn:U. P G {mgt_call pn} |] ==> P G {mgt c}"
wenzelm@19803
   363
    and "!!pn. pn : U ==> wt (the (body pn))"
wenzelm@19803
   364
  shows "finite U ==> uG = mgt_call`U ==>  
wenzelm@19803
   365
  !G. G <= uG --> n <= card uG --> card G = card uG - n --> (!c. wt c --> P G {mgt c})"
wenzelm@19803
   366
apply (induct_tac n)
wenzelm@42793
   367
apply  (tactic {* ALLGOALS (clarsimp_tac @{context}) *})
wenzelm@19803
   368
apply  (subgoal_tac "G = mgt_call ` U")
wenzelm@19803
   369
prefer 2
nipkow@40786
   370
apply   (simp add: card_seteq)
wenzelm@19803
   371
apply  simp
wenzelm@41529
   372
apply  (erule assms(3-)) (*MGF_lemma1*)
wenzelm@19803
   373
apply (rule ballI)
wenzelm@41529
   374
apply  (rule assms) (*hoare_derivs.asm*)
wenzelm@19803
   375
apply  fast
wenzelm@41529
   376
apply (erule assms(3-)) (*MGF_lemma1*)
wenzelm@19803
   377
apply (rule ballI)
wenzelm@19803
   378
apply (case_tac "mgt_call pn : G")
wenzelm@41529
   379
apply  (rule assms) (*hoare_derivs.asm*)
wenzelm@19803
   380
apply  fast
wenzelm@41529
   381
apply (rule assms(2-)) (*MGT_BodyN*)
wenzelm@19803
   382
apply (drule spec, erule impE, erule_tac [2] impE, drule_tac [3] spec, erule_tac [3] mp)
wenzelm@41529
   383
apply   (erule_tac [3] assms(4-))
wenzelm@19803
   384
apply   fast
wenzelm@19803
   385
apply (drule finite_subset)
wenzelm@19803
   386
apply (erule finite_imageI)
wenzelm@19803
   387
apply (simp (no_asm_simp))
wenzelm@19803
   388
done
wenzelm@19803
   389
wenzelm@19803
   390
lemma MGT_BodyN: "insert ({=}.BODY pn.{->}) G|-{=}. the (body pn) .{->} ==>  
wenzelm@19803
   391
  G|-{=}.BODY pn.{->}"
wenzelm@19803
   392
apply (unfold MGT_def)
wenzelm@19803
   393
apply (rule BodyN)
wenzelm@19803
   394
apply (erule conseq2)
wenzelm@19803
   395
apply force
wenzelm@19803
   396
done
wenzelm@19803
   397
wenzelm@19803
   398
(* requires BodyN, com_det *)
wenzelm@19803
   399
lemma MGF: "[| state_not_singleton; WT_bodies; WT c |] ==> {}|-MGT c"
wenzelm@19803
   400
apply (rule_tac P = "%G ts. G||-ts" and U = "dom body" in nesting_lemma)
wenzelm@19803
   401
apply (erule hoare_derivs.asm)
wenzelm@19803
   402
apply (erule MGT_BodyN)
wenzelm@19803
   403
apply (rule_tac [3] finite_dom_body)
wenzelm@19803
   404
apply (erule MGF_lemma1)
wenzelm@19803
   405
prefer 2 apply (assumption)
wenzelm@19803
   406
apply       blast
wenzelm@19803
   407
apply      clarsimp
wenzelm@19803
   408
apply     (erule (1) WT_bodiesD)
wenzelm@19803
   409
apply (rule_tac [3] le_refl)
wenzelm@19803
   410
apply    auto
wenzelm@19803
   411
done
wenzelm@19803
   412
wenzelm@19803
   413
wenzelm@19803
   414
(* Version: simultaneous recursion in call rule *)
wenzelm@19803
   415
wenzelm@19803
   416
(* finiteness not really necessary here *)
wenzelm@19803
   417
lemma MGT_Body: "[| G Un (%pn. {=}.      BODY pn  .{->})`Procs  
wenzelm@19803
   418
                          ||-(%pn. {=}. the (body pn) .{->})`Procs;  
wenzelm@19803
   419
  finite Procs |] ==>   G ||-(%pn. {=}.      BODY pn  .{->})`Procs"
wenzelm@19803
   420
apply (unfold MGT_def)
wenzelm@19803
   421
apply (rule hoare_derivs.Body)
wenzelm@19803
   422
apply (erule finite_pointwise)
wenzelm@19803
   423
prefer 2 apply (assumption)
wenzelm@19803
   424
apply clarify
wenzelm@19803
   425
apply (erule conseq2)
wenzelm@19803
   426
apply auto
wenzelm@19803
   427
done
wenzelm@19803
   428
wenzelm@19803
   429
(* requires empty, insert, com_det *)
wenzelm@19803
   430
lemma MGF_lemma2_simult [rule_format (no_asm)]: "[| state_not_singleton; WT_bodies;  
wenzelm@19803
   431
  F<=(%pn. {=}.the (body pn).{->})`dom body |] ==>  
wenzelm@19803
   432
     (%pn. {=}.     BODY pn .{->})`dom body||-F"
wenzelm@19803
   433
apply (frule finite_subset)
wenzelm@19803
   434
apply (rule finite_dom_body [THEN finite_imageI])
wenzelm@19803
   435
apply (rotate_tac 2)
wenzelm@19803
   436
apply (tactic "make_imp_tac 1")
wenzelm@19803
   437
apply (erule finite_induct)
wenzelm@19803
   438
apply  (clarsimp intro!: hoare_derivs.empty)
wenzelm@19803
   439
apply (clarsimp intro!: hoare_derivs.insert simp del: range_composition)
wenzelm@19803
   440
apply (erule MGF_lemma1)
wenzelm@19803
   441
prefer 2 apply  (fast dest: WT_bodiesD)
wenzelm@19803
   442
apply clarsimp
wenzelm@19803
   443
apply (rule hoare_derivs.asm)
wenzelm@19803
   444
apply (fast intro: domI)
wenzelm@19803
   445
done
wenzelm@19803
   446
wenzelm@19803
   447
(* requires Body, empty, insert, com_det *)
wenzelm@19803
   448
lemma MGF': "[| state_not_singleton; WT_bodies; WT c |] ==> {}|-MGT c"
wenzelm@19803
   449
apply (rule MGF_lemma1)
wenzelm@19803
   450
apply assumption
wenzelm@19803
   451
prefer 2 apply (assumption)
wenzelm@19803
   452
apply clarsimp
wenzelm@19803
   453
apply (subgoal_tac "{}||- (%pn. {=}. BODY pn .{->}) `dom body")
wenzelm@19803
   454
apply (erule hoare_derivs.weaken)
wenzelm@19803
   455
apply  (fast intro: domI)
wenzelm@19803
   456
apply (rule finite_dom_body [THEN [2] MGT_Body])
wenzelm@19803
   457
apply (simp (no_asm))
wenzelm@19803
   458
apply (erule (1) MGF_lemma2_simult)
wenzelm@19803
   459
apply (rule subset_refl)
wenzelm@19803
   460
done
wenzelm@19803
   461
wenzelm@19803
   462
(* requires Body+empty+insert / BodyN, com_det *)
wenzelm@19803
   463
lemmas hoare_complete = MGF' [THEN MGF_complete, standard]
wenzelm@19803
   464
wenzelm@19803
   465
wenzelm@19803
   466
subsection "unused derived rules"
wenzelm@19803
   467
wenzelm@19803
   468
lemma falseE: "G|-{%Z s. False}.c.{Q}"
wenzelm@19803
   469
apply (rule hoare_derivs.conseq)
wenzelm@19803
   470
apply fast
wenzelm@19803
   471
done
wenzelm@19803
   472
wenzelm@19803
   473
lemma trueI: "G|-{P}.c.{%Z s. True}"
wenzelm@19803
   474
apply (rule hoare_derivs.conseq)
wenzelm@19803
   475
apply (fast intro!: falseE)
wenzelm@19803
   476
done
wenzelm@19803
   477
wenzelm@19803
   478
lemma disj: "[| G|-{P}.c.{Q}; G|-{P'}.c.{Q'} |]  
wenzelm@19803
   479
        ==> G|-{%Z s. P Z s | P' Z s}.c.{%Z s. Q Z s | Q' Z s}"
wenzelm@19803
   480
apply (rule hoare_derivs.conseq)
wenzelm@19803
   481
apply (fast elim: conseq12)
wenzelm@19803
   482
done (* analogue conj non-derivable *)
wenzelm@19803
   483
wenzelm@19803
   484
lemma hoare_SkipI: "(!Z s. P Z s --> Q Z s) ==> G|-{P}. SKIP .{Q}"
wenzelm@19803
   485
apply (rule conseq12)
wenzelm@19803
   486
apply (rule hoare_derivs.Skip)
wenzelm@19803
   487
apply fast
wenzelm@19803
   488
done
wenzelm@19803
   489
wenzelm@19803
   490
wenzelm@19803
   491
subsection "useful derived rules"
wenzelm@19803
   492
wenzelm@19803
   493
lemma single_asm: "{t}|-t"
wenzelm@19803
   494
apply (rule hoare_derivs.asm)
wenzelm@19803
   495
apply (rule subset_refl)
wenzelm@19803
   496
done
wenzelm@19803
   497
wenzelm@19803
   498
lemma export_s: "[| !!s'. G|-{%Z s. s'=s & P Z s}.c.{Q} |] ==> G|-{P}.c.{Q}"
wenzelm@19803
   499
apply (rule hoare_derivs.conseq)
wenzelm@19803
   500
apply auto
wenzelm@19803
   501
done
wenzelm@19803
   502
wenzelm@19803
   503
wenzelm@19803
   504
lemma weak_Local: "[| G|-{P}. c .{Q}; !k Z s. Q Z s --> Q Z (s[Loc Y::=k]) |] ==>  
wenzelm@19803
   505
    G|-{%Z s. P Z (s[Loc Y::=a s])}. LOCAL Y:=a IN c .{Q}"
wenzelm@19803
   506
apply (rule export_s)
wenzelm@19803
   507
apply (rule hoare_derivs.Local)
wenzelm@19803
   508
apply (erule conseq2)
wenzelm@19803
   509
apply (erule spec)
wenzelm@19803
   510
done
wenzelm@19803
   511
wenzelm@19803
   512
(*
wenzelm@19803
   513
Goal "!Q. G |-{%Z s. ~(? s'. <c,s> -c-> s')}. c .{Q}"
wenzelm@19803
   514
by (induct_tac "c" 1);
wenzelm@19803
   515
by Auto_tac;
wenzelm@19803
   516
by (rtac conseq1 1);
wenzelm@19803
   517
by (rtac hoare_derivs.Skip 1);
wenzelm@19803
   518
force 1;
wenzelm@19803
   519
by (rtac conseq1 1);
wenzelm@19803
   520
by (rtac hoare_derivs.Ass 1);
wenzelm@19803
   521
force 1;
wenzelm@19803
   522
by (defer_tac 1);
wenzelm@19803
   523
###
wenzelm@19803
   524
by (rtac hoare_derivs.Comp 1);
wenzelm@19803
   525
by (dtac spec 2);
wenzelm@19803
   526
by (dtac spec 2);
wenzelm@19803
   527
by (assume_tac 2);
wenzelm@19803
   528
by (etac conseq1 2);
wenzelm@19803
   529
by (Clarsimp_tac 2);
wenzelm@19803
   530
force 1;
wenzelm@19803
   531
*)
oheimb@8177
   532
oheimb@8177
   533
end