TLA: converted legacy ML scripts;
authorwenzelm
Sat Dec 02 02:52:02 2006 +0100 (2006-12-02)
changeset 216246f79647cf536
parent 21623 17098171d46a
child 21625 fa8a7de5da28
TLA: converted legacy ML scripts;
src/HOL/IsaMakefile
src/HOL/TLA/Action.ML
src/HOL/TLA/Action.thy
src/HOL/TLA/Buffer/Buffer.ML
src/HOL/TLA/Buffer/Buffer.thy
src/HOL/TLA/Buffer/DBuffer.ML
src/HOL/TLA/Buffer/DBuffer.thy
src/HOL/TLA/Inc/Inc.ML
src/HOL/TLA/Inc/Inc.thy
src/HOL/TLA/Init.ML
src/HOL/TLA/Init.thy
src/HOL/TLA/Intensional.ML
src/HOL/TLA/Intensional.thy
src/HOL/TLA/Memory/MIsafe.ML
src/HOL/TLA/Memory/MemClerk.ML
src/HOL/TLA/Memory/MemClerk.thy
src/HOL/TLA/Memory/MemClerkParameters.ML
src/HOL/TLA/Memory/MemClerkParameters.thy
src/HOL/TLA/Memory/Memory.ML
src/HOL/TLA/Memory/Memory.thy
src/HOL/TLA/Memory/MemoryImplementation.ML
src/HOL/TLA/Memory/MemoryImplementation.thy
src/HOL/TLA/Memory/MemoryParameters.ML
src/HOL/TLA/Memory/MemoryParameters.thy
src/HOL/TLA/Memory/ProcedureInterface.ML
src/HOL/TLA/Memory/ProcedureInterface.thy
src/HOL/TLA/Memory/RPC.ML
src/HOL/TLA/Memory/RPC.thy
src/HOL/TLA/Memory/RPCMemoryParams.thy
src/HOL/TLA/Memory/RPCParameters.ML
src/HOL/TLA/Memory/RPCParameters.thy
src/HOL/TLA/Stfun.ML
src/HOL/TLA/Stfun.thy
src/HOL/TLA/TLA.ML
src/HOL/TLA/TLA.thy
     1.1 --- a/src/HOL/IsaMakefile	Fri Dec 01 17:22:33 2006 +0100
     1.2 +++ b/src/HOL/IsaMakefile	Sat Dec 02 02:52:02 2006 +0100
     1.3 @@ -693,9 +693,8 @@
     1.4  
     1.5  TLA: HOL $(OUT)/TLA
     1.6  
     1.7 -$(OUT)/TLA: $(OUT)/HOL TLA/Action.ML TLA/Action.thy TLA/Init.ML \
     1.8 -  TLA/Init.thy TLA/Intensional.ML TLA/Intensional.thy \
     1.9 -  TLA/ROOT.ML TLA/Stfun.ML TLA/Stfun.thy TLA/TLA.ML TLA/TLA.thy
    1.10 +$(OUT)/TLA: $(OUT)/HOL TLA/Action.thy TLA/Init.thy TLA/Intensional.thy \
    1.11 +  TLA/ROOT.ML TLA/Stfun.thy TLA/TLA.thy
    1.12  	@cd TLA; $(ISATOOL) usedir -b $(OUT)/HOL TLA
    1.13  
    1.14  
    1.15 @@ -703,7 +702,7 @@
    1.16  
    1.17  TLA-Inc: TLA $(LOG)/TLA-Inc.gz
    1.18  
    1.19 -$(LOG)/TLA-Inc.gz: $(OUT)/TLA TLA/Inc/Inc.thy TLA/Inc/Inc.ML
    1.20 +$(LOG)/TLA-Inc.gz: $(OUT)/TLA TLA/Inc/Inc.thy
    1.21  	@cd TLA; $(ISATOOL) usedir $(OUT)/TLA Inc
    1.22  
    1.23  
    1.24 @@ -711,8 +710,7 @@
    1.25  
    1.26  TLA-Buffer: TLA $(LOG)/TLA-Buffer.gz
    1.27  
    1.28 -$(LOG)/TLA-Buffer.gz: $(OUT)/TLA TLA/Buffer/Buffer.thy \
    1.29 -  TLA/Buffer/Buffer.ML TLA/Buffer/DBuffer.thy TLA/Buffer/DBuffer.ML
    1.30 +$(LOG)/TLA-Buffer.gz: $(OUT)/TLA TLA/Buffer/Buffer.thy TLA/Buffer/DBuffer.thy
    1.31  	@cd TLA; $(ISATOOL) usedir $(OUT)/TLA Buffer
    1.32  
    1.33  
    1.34 @@ -721,15 +719,10 @@
    1.35  TLA-Memory: TLA $(LOG)/TLA-Memory.gz
    1.36  
    1.37  $(LOG)/TLA-Memory.gz: $(OUT)/TLA TLA/Memory/MIParameters.thy \
    1.38 -  TLA/Memory/MIsafe.ML TLA/Memory/MemClerk.ML \
    1.39 -  TLA/Memory/MemClerk.thy TLA/Memory/MemClerkParameters.ML \
    1.40 -  TLA/Memory/MemClerkParameters.thy TLA/Memory/Memory.ML \
    1.41 -  TLA/Memory/Memory.thy TLA/Memory/MemoryImplementation.ML \
    1.42 -  TLA/Memory/MemoryImplementation.thy TLA/Memory/MemoryParameters.ML \
    1.43 -  TLA/Memory/MemoryParameters.thy TLA/Memory/ProcedureInterface.ML \
    1.44 -  TLA/Memory/ProcedureInterface.thy TLA/Memory/RPC.ML TLA/Memory/RPC.thy \
    1.45 -  TLA/Memory/RPCMemoryParams.thy TLA/Memory/RPCParameters.ML \
    1.46 -  TLA/Memory/RPCParameters.thy
    1.47 +  TLA/Memory/MemClerk.thy TLA/Memory/MemClerkParameters.thy \
    1.48 +  TLA/Memory/Memory.thy TLA/Memory/MemoryImplementation.thy \
    1.49 +  TLA/Memory/MemoryParameters.thy TLA/Memory/ProcedureInterface.thy TLA/Memory/RPC.thy \
    1.50 +  TLA/Memory/RPCMemoryParams.thy TLA/Memory/RPCParameters.thy
    1.51  	@cd TLA; $(ISATOOL) usedir $(OUT)/TLA Memory
    1.52  
    1.53  
     2.1 --- a/src/HOL/TLA/Action.ML	Fri Dec 01 17:22:33 2006 +0100
     2.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.3 @@ -1,248 +0,0 @@
     2.4 -(*
     2.5 -    File:        Action.ML
     2.6 -    ID:          $Id$
     2.7 -    Author:      Stephan Merz
     2.8 -    Copyright:   1997 University of Munich
     2.9 -
    2.10 -Lemmas and tactics for TLA actions.
    2.11 -*)
    2.12 -
    2.13 -(* The following assertion specializes "intI" for any world type
    2.14 -   which is a pair, not just for "state * state".
    2.15 -*)
    2.16 -val [prem] = goal (the_context ()) "(!!s t. (s,t) |= A) ==> |- A";
    2.17 -by (REPEAT (resolve_tac [prem,intI,prod_induct] 1));
    2.18 -qed "actionI";
    2.19 -
    2.20 -Goal "|- A ==> (s,t) |= A";
    2.21 -by (etac intD 1);
    2.22 -qed "actionD";
    2.23 -
    2.24 -local
    2.25 -  fun prover s = prove_goal (the_context ()) s
    2.26 -                    (fn _ => [rtac actionI 1,
    2.27 -                              rewrite_goals_tac (unl_after::intensional_rews),
    2.28 -                              rtac refl 1])
    2.29 -in
    2.30 -  val pr_rews = map (int_rewrite o prover)
    2.31 -    [ "|- (#c)` = #c",
    2.32 -      "|- f<x>` = f<x` >",
    2.33 -      "|- f<x,y>` = f<x`,y` >",
    2.34 -      "|- f<x,y,z>` = f<x`,y`,z` >",
    2.35 -      "|- (! x. P x)` = (! x. (P x)`)",
    2.36 -      "|- (? x. P x)` = (? x. (P x)`)"
    2.37 -    ]
    2.38 -end;
    2.39 -
    2.40 -val act_rews = [unl_before,unl_after,unchanged_def] @ pr_rews;
    2.41 -Addsimps act_rews;
    2.42 -
    2.43 -val action_rews = act_rews @ intensional_rews;
    2.44 -
    2.45 -(* ================ Functions to "unlift" action theorems into HOL rules ================ *)
    2.46 -
    2.47 -(* The following functions are specialized versions of the corresponding
    2.48 -   functions defined in Intensional.ML in that they introduce a
    2.49 -   "world" parameter of the form (s,t) and apply additional rewrites.
    2.50 -*)
    2.51 -fun action_unlift th =
    2.52 -    (rewrite_rule action_rews (th RS actionD))
    2.53 -    handle _ => int_unlift th;
    2.54 -
    2.55 -(* Turn  |- A = B  into meta-level rewrite rule  A == B *)
    2.56 -val action_rewrite = int_rewrite;
    2.57 -
    2.58 -fun action_use th =
    2.59 -    case (concl_of th) of
    2.60 -      Const _ $ (Const ("Intensional.Valid", _) $ _) =>
    2.61 -              ((flatten (action_unlift th)) handle _ => th)
    2.62 -    | _ => th;
    2.63 -
    2.64 -(* ===================== Update simpset and classical prover ============================= *)
    2.65 -
    2.66 -AddSIs [actionI];
    2.67 -AddDs  [actionD];
    2.68 -
    2.69 -(* =========================== square / angle brackets =========================== *)
    2.70 -
    2.71 -Goalw [square_def] "(s,t) |= unchanged v ==> (s,t) |= [A]_v";
    2.72 -by (Asm_full_simp_tac 1);
    2.73 -qed "idle_squareI";
    2.74 -
    2.75 -Goalw [square_def] "(s,t) |= A ==> (s,t) |= [A]_v";
    2.76 -by (Asm_simp_tac 1);
    2.77 -qed "busy_squareI";
    2.78 -
    2.79 -val prems = goal (the_context ())
    2.80 -  "[| (s,t) |= [A]_v; A (s,t) ==> B (s,t); v t = v s ==> B (s,t) |] ==> B (s,t)";
    2.81 -by (cut_facts_tac prems 1);
    2.82 -by (rewrite_goals_tac (square_def::action_rews));
    2.83 -by (etac disjE 1);
    2.84 -by (REPEAT (eresolve_tac prems 1));
    2.85 -qed "squareE";
    2.86 -
    2.87 -val prems = goalw (the_context ()) (square_def::action_rews)
    2.88 -  "[| v t ~= v s ==> A (s,t) |] ==> (s,t) |= [A]_v";
    2.89 -by (rtac disjCI 1);
    2.90 -by (eresolve_tac prems 1);
    2.91 -qed "squareCI";
    2.92 -
    2.93 -goalw (the_context ()) [angle_def]
    2.94 -  "!!s t. [| A (s,t); v t ~= v s |] ==> (s,t) |= <A>_v";
    2.95 -by (Asm_simp_tac 1);
    2.96 -qed "angleI";
    2.97 -
    2.98 -val prems = goalw (the_context ()) (angle_def::action_rews)
    2.99 -  "[| (s,t) |= <A>_v; [| A (s,t); v t ~= v s |] ==> R |] ==> R";
   2.100 -by (cut_facts_tac prems 1);
   2.101 -by (etac conjE 1);
   2.102 -by (REPEAT (ares_tac prems 1));
   2.103 -qed "angleE";
   2.104 -
   2.105 -AddIs [angleI, squareCI];
   2.106 -AddEs [angleE, squareE];
   2.107 -
   2.108 -goal (the_context ())
   2.109 -   "!!f. [| |- unchanged f & ~B --> unchanged g;   \
   2.110 -\           |- A & ~unchanged g --> B              \
   2.111 -\        |] ==> |- [A]_f --> [B]_g";
   2.112 -by (Clarsimp_tac 1);
   2.113 -by (etac squareE 1);
   2.114 -by (auto_tac (claset(), simpset() addsimps [square_def]));
   2.115 -qed "square_simulation";
   2.116 -
   2.117 -goalw (the_context ()) [square_def,angle_def]
   2.118 -   "|- (~ [A]_v) = <~A>_v";
   2.119 -by Auto_tac;
   2.120 -qed "not_square";
   2.121 -
   2.122 -goalw (the_context ()) [square_def,angle_def]
   2.123 -   "|- (~ <A>_v) = [~A]_v";
   2.124 -by Auto_tac;
   2.125 -qed "not_angle";
   2.126 -
   2.127 -(* ============================== Facts about ENABLED ============================== *)
   2.128 -
   2.129 -goal (the_context ()) "|- A --> $Enabled A";
   2.130 -by (auto_tac (claset(), simpset() addsimps [enabled_def]));
   2.131 -qed "enabledI";
   2.132 -
   2.133 -val prems = goalw (the_context ()) [enabled_def]
   2.134 -  "[| s |= Enabled A; !!u. A (s,u) ==> Q |] ==> Q";
   2.135 -by (cut_facts_tac prems 1);
   2.136 -by (etac exE 1);
   2.137 -by (resolve_tac prems 1);
   2.138 -by (atac 1);
   2.139 -qed "enabledE";
   2.140 -
   2.141 -goal (the_context ()) "|- ~$Enabled G --> ~ G";
   2.142 -by (auto_tac (claset(), simpset() addsimps [enabled_def]));
   2.143 -qed "notEnabledD";
   2.144 -
   2.145 -(* Monotonicity *)
   2.146 -val [min,maj] = goal (the_context ())
   2.147 -  "[| s |= Enabled F; |- F --> G |] ==> s |= Enabled G";
   2.148 -by (rtac (min RS enabledE) 1);
   2.149 -by (rtac (action_use enabledI) 1);
   2.150 -by (etac (action_use maj) 1);
   2.151 -qed "enabled_mono";
   2.152 -
   2.153 -(* stronger variant *)
   2.154 -val [min,maj] = goal (the_context ())
   2.155 -  "[| s |= Enabled F; !!t. F (s,t) ==> G (s,t) |] ==> s |= Enabled G";
   2.156 -by (rtac (min RS enabledE) 1);
   2.157 -by (rtac (action_use enabledI) 1);
   2.158 -by (etac maj 1);
   2.159 -qed "enabled_mono2";
   2.160 -
   2.161 -goal (the_context ()) "|- Enabled F --> Enabled (F | G)";
   2.162 -by (auto_tac (claset() addSEs [enabled_mono], simpset()));
   2.163 -qed "enabled_disj1";
   2.164 -
   2.165 -goal (the_context ()) "|- Enabled G --> Enabled (F | G)";
   2.166 -by (auto_tac (claset() addSEs [enabled_mono], simpset()));
   2.167 -qed "enabled_disj2";
   2.168 -
   2.169 -goal (the_context ()) "|- Enabled (F & G) --> Enabled F";
   2.170 -by (auto_tac (claset() addSEs [enabled_mono], simpset()));
   2.171 -qed "enabled_conj1";
   2.172 -
   2.173 -goal (the_context ()) "|- Enabled (F & G) --> Enabled G";
   2.174 -by (auto_tac (claset() addSEs [enabled_mono], simpset()));
   2.175 -qed "enabled_conj2";
   2.176 -
   2.177 -val prems = goal (the_context ())
   2.178 -  "[| s |= Enabled (F & G); [| s |= Enabled F; s |= Enabled G |] ==> Q |] ==> Q";
   2.179 -by (cut_facts_tac prems 1);
   2.180 -by (resolve_tac prems 1);
   2.181 -by (etac (action_use enabled_conj1) 1);
   2.182 -by (etac (action_use enabled_conj2) 1);
   2.183 -qed "enabled_conjE";
   2.184 -
   2.185 -goal (the_context ()) "|- Enabled (F | G) --> Enabled F | Enabled G";
   2.186 -by (auto_tac (claset(), simpset() addsimps [enabled_def]));
   2.187 -qed "enabled_disjD";
   2.188 -
   2.189 -goal (the_context ()) "|- Enabled (F | G) = (Enabled F | Enabled G)";
   2.190 -by (Clarsimp_tac 1);
   2.191 -by (rtac iffI 1);
   2.192 -by (etac (action_use enabled_disjD) 1);
   2.193 -by (REPEAT (eresolve_tac (disjE::map action_use [enabled_disj1,enabled_disj2]) 1));
   2.194 -qed "enabled_disj";
   2.195 -
   2.196 -goal (the_context ()) "|- Enabled (EX x. F x) = (EX x. Enabled (F x))";
   2.197 -by (force_tac (claset(), simpset() addsimps [enabled_def]) 1);
   2.198 -qed "enabled_ex";
   2.199 -
   2.200 -
   2.201 -(* A rule that combines enabledI and baseE, but generates fewer instantiations *)
   2.202 -val prems = goal (the_context ())
   2.203 -  "[| basevars vs; EX c. ! u. vs u = c --> A(s,u) |] ==> s |= Enabled A";
   2.204 -by (cut_facts_tac prems 1);
   2.205 -by (etac exE 1);
   2.206 -by (etac baseE 1);
   2.207 -by (rtac (action_use enabledI) 1);
   2.208 -by (etac allE 1);
   2.209 -by (etac mp 1);
   2.210 -by (atac 1);
   2.211 -qed "base_enabled";
   2.212 -
   2.213 -(* ======================= action_simp_tac ============================== *)
   2.214 -
   2.215 -(* A dumb simplification-based tactic with just a little first-order logic:
   2.216 -   should plug in only "very safe" rules that can be applied blindly.
   2.217 -   Note that it applies whatever simplifications are currently active.
   2.218 -*)
   2.219 -fun action_simp_tac ss intros elims =
   2.220 -    asm_full_simp_tac
   2.221 -         (ss setloop ((resolve_tac ((map action_use intros)
   2.222 -                                    @ [refl,impI,conjI,actionI,intI,allI]))
   2.223 -                      ORELSE' (eresolve_tac ((map action_use elims)
   2.224 -                                             @ [conjE,disjE,exE]))));
   2.225 -
   2.226 -(* default version without additional plug-in rules *)
   2.227 -val Action_simp_tac = action_simp_tac (simpset()) [] [];
   2.228 -
   2.229 -
   2.230 -
   2.231 -(* ---------------- enabled_tac: tactic to prove (Enabled A) -------------------- *)
   2.232 -(* "Enabled A" can be proven as follows:
   2.233 -   - Assume that we know which state variables are "base variables";
   2.234 -     this should be expressed by a theorem of the form "basevars (x,y,z,...)".
   2.235 -   - Resolve this theorem with baseE to introduce a constant for the value of the
   2.236 -     variables in the successor state, and resolve the goal with the result.
   2.237 -   - Resolve with enabledI and do some rewriting.
   2.238 -   - Solve for the unknowns using standard HOL reasoning.
   2.239 -   The following tactic combines these steps except the final one.
   2.240 -*)
   2.241 -
   2.242 -fun enabled_tac base_vars =
   2.243 -    clarsimp_tac (claset() addSIs [base_vars RS base_enabled], simpset());
   2.244 -
   2.245 -(* Example:
   2.246 -
   2.247 -val [prem] = goal (the_context ()) "basevars (x,y,z) ==> |- x --> Enabled ($x & (y$ = #False))";
   2.248 -by (enabled_tac prem 1);
   2.249 -by Auto_tac;
   2.250 -
   2.251 -*)
     3.1 --- a/src/HOL/TLA/Action.thy	Fri Dec 01 17:22:33 2006 +0100
     3.2 +++ b/src/HOL/TLA/Action.thy	Sat Dec 02 02:52:02 2006 +0100
     3.3 @@ -3,12 +3,9 @@
     3.4      ID:          $Id$
     3.5      Author:      Stephan Merz
     3.6      Copyright:   1998 University of Munich
     3.7 +*)
     3.8  
     3.9 -    Theory Name: Action
    3.10 -    Logic Image: HOL
    3.11 -
    3.12 -Define the action level of TLA as an Isabelle theory.
    3.13 -*)
    3.14 +header {* The action level of TLA as an Isabelle theory *}
    3.15  
    3.16  theory Action
    3.17  imports Stfun
    3.18 @@ -75,6 +72,250 @@
    3.19  
    3.20    enabled_def:   "s |= Enabled A  ==  EX u. (s,u) |= A"
    3.21  
    3.22 -ML {* use_legacy_bindings (the_context ()) *}
    3.23 +
    3.24 +(* The following assertion specializes "intI" for any world type
    3.25 +   which is a pair, not just for "state * state".
    3.26 +*)
    3.27 +
    3.28 +lemma actionI [intro!]:
    3.29 +  assumes "!!s t. (s,t) |= A"
    3.30 +  shows "|- A"
    3.31 +  apply (rule assms intI prod_induct)+
    3.32 +  done
    3.33 +
    3.34 +lemma actionD [dest]: "|- A ==> (s,t) |= A"
    3.35 +  apply (erule intD)
    3.36 +  done
    3.37 +
    3.38 +lemma pr_rews [int_rewrite]:
    3.39 +  "|- (#c)` = #c"
    3.40 +  "!!f. |- f<x>` = f<x` >"
    3.41 +  "!!f. |- f<x,y>` = f<x`,y` >"
    3.42 +  "!!f. |- f<x,y,z>` = f<x`,y`,z` >"
    3.43 +  "|- (! x. P x)` = (! x. (P x)`)"
    3.44 +  "|- (? x. P x)` = (? x. (P x)`)"
    3.45 +  by (rule actionI, unfold unl_after intensional_rews, rule refl)+
    3.46 +
    3.47 +
    3.48 +lemmas act_rews [simp] = unl_before unl_after unchanged_def pr_rews
    3.49 +
    3.50 +lemmas action_rews = act_rews intensional_rews
    3.51 +
    3.52 +
    3.53 +(* ================ Functions to "unlift" action theorems into HOL rules ================ *)
    3.54 +
    3.55 +ML {*
    3.56 +(* The following functions are specialized versions of the corresponding
    3.57 +   functions defined in Intensional.ML in that they introduce a
    3.58 +   "world" parameter of the form (s,t) and apply additional rewrites.
    3.59 +*)
    3.60 +local
    3.61 +  val action_rews = thms "action_rews";
    3.62 +  val actionD = thm "actionD";
    3.63 +in
    3.64 +
    3.65 +fun action_unlift th =
    3.66 +  (rewrite_rule action_rews (th RS actionD))
    3.67 +    handle THM _ => int_unlift th;
    3.68 +
    3.69 +(* Turn  |- A = B  into meta-level rewrite rule  A == B *)
    3.70 +val action_rewrite = int_rewrite
    3.71 +
    3.72 +fun action_use th =
    3.73 +    case (concl_of th) of
    3.74 +      Const _ $ (Const ("Intensional.Valid", _) $ _) =>
    3.75 +              (flatten (action_unlift th) handle THM _ => th)
    3.76 +    | _ => th;
    3.77  
    3.78  end
    3.79 +*}
    3.80 +
    3.81 +setup {*
    3.82 +  Attrib.add_attributes [
    3.83 +    ("action_unlift", Attrib.no_args (Thm.rule_attribute (K action_unlift)), ""),
    3.84 +    ("action_rewrite", Attrib.no_args (Thm.rule_attribute (K action_rewrite)), ""),
    3.85 +    ("action_use", Attrib.no_args (Thm.rule_attribute (K action_use)), "")]
    3.86 +*}
    3.87 +
    3.88 +
    3.89 +(* =========================== square / angle brackets =========================== *)
    3.90 +
    3.91 +lemma idle_squareI: "(s,t) |= unchanged v ==> (s,t) |= [A]_v"
    3.92 +  by (simp add: square_def)
    3.93 +
    3.94 +lemma busy_squareI: "(s,t) |= A ==> (s,t) |= [A]_v"
    3.95 +  by (simp add: square_def)
    3.96 +  
    3.97 +lemma squareE [elim]:
    3.98 +  "[| (s,t) |= [A]_v; A (s,t) ==> B (s,t); v t = v s ==> B (s,t) |] ==> B (s,t)"
    3.99 +  apply (unfold square_def action_rews)
   3.100 +  apply (erule disjE)
   3.101 +  apply simp_all
   3.102 +  done
   3.103 +
   3.104 +lemma squareCI [intro]: "[| v t ~= v s ==> A (s,t) |] ==> (s,t) |= [A]_v"
   3.105 +  apply (unfold square_def action_rews)
   3.106 +  apply (rule disjCI)
   3.107 +  apply (erule (1) meta_mp)
   3.108 +  done
   3.109 +
   3.110 +lemma angleI [intro]: "!!s t. [| A (s,t); v t ~= v s |] ==> (s,t) |= <A>_v"
   3.111 +  by (simp add: angle_def)
   3.112 +
   3.113 +lemma angleE [elim]: "[| (s,t) |= <A>_v; [| A (s,t); v t ~= v s |] ==> R |] ==> R"
   3.114 +  apply (unfold angle_def action_rews)
   3.115 +  apply (erule conjE)
   3.116 +  apply simp
   3.117 +  done
   3.118 +
   3.119 +lemma square_simulation:
   3.120 +   "!!f. [| |- unchanged f & ~B --> unchanged g;    
   3.121 +            |- A & ~unchanged g --> B               
   3.122 +         |] ==> |- [A]_f --> [B]_g"
   3.123 +  apply clarsimp
   3.124 +  apply (erule squareE)
   3.125 +  apply (auto simp add: square_def)
   3.126 +  done
   3.127 +
   3.128 +lemma not_square: "|- (~ [A]_v) = <~A>_v"
   3.129 +  by (auto simp: square_def angle_def)
   3.130 +
   3.131 +lemma not_angle: "|- (~ <A>_v) = [~A]_v"
   3.132 +  by (auto simp: square_def angle_def)
   3.133 +
   3.134 +
   3.135 +(* ============================== Facts about ENABLED ============================== *)
   3.136 +
   3.137 +lemma enabledI: "|- A --> $Enabled A"
   3.138 +  by (auto simp add: enabled_def)
   3.139 +
   3.140 +lemma enabledE: "[| s |= Enabled A; !!u. A (s,u) ==> Q |] ==> Q"
   3.141 +  apply (unfold enabled_def)
   3.142 +  apply (erule exE)
   3.143 +  apply simp
   3.144 +  done
   3.145 +
   3.146 +lemma notEnabledD: "|- ~$Enabled G --> ~ G"
   3.147 +  by (auto simp add: enabled_def)
   3.148 +
   3.149 +(* Monotonicity *)
   3.150 +lemma enabled_mono:
   3.151 +  assumes min: "s |= Enabled F"
   3.152 +    and maj: "|- F --> G"
   3.153 +  shows "s |= Enabled G"
   3.154 +  apply (rule min [THEN enabledE])
   3.155 +  apply (rule enabledI [action_use])
   3.156 +  apply (erule maj [action_use])
   3.157 +  done
   3.158 +
   3.159 +(* stronger variant *)
   3.160 +lemma enabled_mono2:
   3.161 +  assumes min: "s |= Enabled F"
   3.162 +    and maj: "!!t. F (s,t) ==> G (s,t)"
   3.163 +  shows "s |= Enabled G"
   3.164 +  apply (rule min [THEN enabledE])
   3.165 +  apply (rule enabledI [action_use])
   3.166 +  apply (erule maj)
   3.167 +  done
   3.168 +
   3.169 +lemma enabled_disj1: "|- Enabled F --> Enabled (F | G)"
   3.170 +  by (auto elim!: enabled_mono)
   3.171 +
   3.172 +lemma enabled_disj2: "|- Enabled G --> Enabled (F | G)"
   3.173 +  by (auto elim!: enabled_mono)
   3.174 +
   3.175 +lemma enabled_conj1: "|- Enabled (F & G) --> Enabled F"
   3.176 +  by (auto elim!: enabled_mono)
   3.177 +
   3.178 +lemma enabled_conj2: "|- Enabled (F & G) --> Enabled G"
   3.179 +  by (auto elim!: enabled_mono)
   3.180 +
   3.181 +lemma enabled_conjE:
   3.182 +    "[| s |= Enabled (F & G); [| s |= Enabled F; s |= Enabled G |] ==> Q |] ==> Q"
   3.183 +  apply (frule enabled_conj1 [action_use])
   3.184 +  apply (drule enabled_conj2 [action_use])
   3.185 +  apply simp
   3.186 +  done
   3.187 +
   3.188 +lemma enabled_disjD: "|- Enabled (F | G) --> Enabled F | Enabled G"
   3.189 +  by (auto simp add: enabled_def)
   3.190 +
   3.191 +lemma enabled_disj: "|- Enabled (F | G) = (Enabled F | Enabled G)"
   3.192 +  apply clarsimp
   3.193 +  apply (rule iffI)
   3.194 +   apply (erule enabled_disjD [action_use])
   3.195 +  apply (erule disjE enabled_disj1 [action_use] enabled_disj2 [action_use])+
   3.196 +  done
   3.197 +
   3.198 +lemma enabled_ex: "|- Enabled (EX x. F x) = (EX x. Enabled (F x))"
   3.199 +  by (force simp add: enabled_def)
   3.200 +
   3.201 +
   3.202 +(* A rule that combines enabledI and baseE, but generates fewer instantiations *)
   3.203 +lemma base_enabled:
   3.204 +    "[| basevars vs; EX c. ! u. vs u = c --> A(s,u) |] ==> s |= Enabled A"
   3.205 +  apply (erule exE)
   3.206 +  apply (erule baseE)
   3.207 +  apply (rule enabledI [action_use])
   3.208 +  apply (erule allE)
   3.209 +  apply (erule mp)
   3.210 +  apply assumption
   3.211 +  done
   3.212 +
   3.213 +(* ======================= action_simp_tac ============================== *)
   3.214 +
   3.215 +ML {*
   3.216 +(* A dumb simplification-based tactic with just a little first-order logic:
   3.217 +   should plug in only "very safe" rules that can be applied blindly.
   3.218 +   Note that it applies whatever simplifications are currently active.
   3.219 +*)
   3.220 +local
   3.221 +  val actionI = thm "actionI";
   3.222 +  val intI = thm "intI";
   3.223 +in
   3.224 +
   3.225 +fun action_simp_tac ss intros elims =
   3.226 +    asm_full_simp_tac
   3.227 +         (ss setloop ((resolve_tac ((map action_use intros)
   3.228 +                                    @ [refl,impI,conjI,actionI,intI,allI]))
   3.229 +                      ORELSE' (eresolve_tac ((map action_use elims)
   3.230 +                                             @ [conjE,disjE,exE]))));
   3.231 +
   3.232 +(* default version without additional plug-in rules *)
   3.233 +val Action_simp_tac = action_simp_tac (simpset()) [] []
   3.234 +
   3.235 +end
   3.236 +*}
   3.237 +
   3.238 +(* ---------------- enabled_tac: tactic to prove (Enabled A) -------------------- *)
   3.239 +
   3.240 +ML {*
   3.241 +(* "Enabled A" can be proven as follows:
   3.242 +   - Assume that we know which state variables are "base variables"
   3.243 +     this should be expressed by a theorem of the form "basevars (x,y,z,...)".
   3.244 +   - Resolve this theorem with baseE to introduce a constant for the value of the
   3.245 +     variables in the successor state, and resolve the goal with the result.
   3.246 +   - Resolve with enabledI and do some rewriting.
   3.247 +   - Solve for the unknowns using standard HOL reasoning.
   3.248 +   The following tactic combines these steps except the final one.
   3.249 +*)
   3.250 +local
   3.251 +  val base_enabled = thm "base_enabled";
   3.252 +in
   3.253 +
   3.254 +fun enabled_tac base_vars =
   3.255 +  clarsimp_tac (claset() addSIs [base_vars RS base_enabled], simpset());
   3.256 +
   3.257 +end
   3.258 +*}
   3.259 +
   3.260 +(* Example *)
   3.261 +
   3.262 +lemma
   3.263 +  assumes "basevars (x,y,z)"
   3.264 +  shows "|- x --> Enabled ($x & (y$ = #False))"
   3.265 +  apply (tactic {* enabled_tac (thm "assms") 1 *})
   3.266 +  apply auto
   3.267 +  done
   3.268 +
   3.269 +end
     4.1 --- a/src/HOL/TLA/Buffer/Buffer.ML	Fri Dec 01 17:22:33 2006 +0100
     4.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.3 @@ -1,37 +0,0 @@
     4.4 -(*
     4.5 -    File:        Buffer.ML
     4.6 -    ID:          $Id$
     4.7 -    Author:      Stephan Merz
     4.8 -    Copyright:   1997 University of Munich
     4.9 -
    4.10 -    Simple FIFO buffer (theorems and proofs)
    4.11 -*)
    4.12 -
    4.13 -(* ---------------------------- Data lemmas ---------------------------- *)
    4.14 -
    4.15 -(*FIXME: move to theory List? Maybe as (tl xs = xs) = (xs = [])"?*)
    4.16 -Goal "xs ~= [] --> tl xs ~= xs";
    4.17 -by (auto_tac (claset(), simpset() addsimps [neq_Nil_conv]));
    4.18 -qed_spec_mp "tl_not_self";
    4.19 -
    4.20 -Addsimps [tl_not_self];
    4.21 -
    4.22 -(* ---------------------------- Action lemmas ---------------------------- *)
    4.23 -
    4.24 -(* Dequeue is visible *)
    4.25 -Goalw [angle_def,Deq_def] "|- <Deq ic q oc>_(ic,q,oc) = Deq ic q oc";
    4.26 -by (REPEAT (Safe_tac THEN Asm_lr_simp_tac 1));
    4.27 -qed "Deq_visible";
    4.28 -
    4.29 -(* Enabling condition for dequeue -- NOT NEEDED *)
    4.30 -Goalw [temp_rewrite Deq_visible]
    4.31 -   "!!q. basevars (ic,q,oc) ==> |- Enabled (<Deq ic q oc>_(ic,q,oc)) = (q ~= #[])";
    4.32 -by (force_tac (claset() addSEs [base_enabled,enabledE],
    4.33 -               simpset() addsimps [Deq_def]) 1);
    4.34 -qed "Deq_enabled";
    4.35 -
    4.36 -(* For the left-to-right implication, we don't need the base variable stuff *)
    4.37 -Goalw [temp_rewrite Deq_visible]
    4.38 -   "|- Enabled (<Deq ic q oc>_(ic,q,oc)) --> (q ~= #[])";
    4.39 -by (auto_tac (claset() addSEs [enabledE], simpset() addsimps [Deq_def]));
    4.40 -qed "Deq_enabledE";
     5.1 --- a/src/HOL/TLA/Buffer/Buffer.thy	Fri Dec 01 17:22:33 2006 +0100
     5.2 +++ b/src/HOL/TLA/Buffer/Buffer.thy	Sat Dec 02 02:52:02 2006 +0100
     5.3 @@ -3,9 +3,6 @@
     5.4      ID:          $Id$
     5.5      Author:      Stephan Merz
     5.6      Copyright:   1997 University of Munich
     5.7 -
     5.8 -   Theory Name: Buffer
     5.9 -   Logic Image: TLA
    5.10  *)
    5.11  
    5.12  header {* A simple FIFO buffer (synchronous communication, interleaving) *}
    5.13 @@ -40,6 +37,34 @@
    5.14                                        & WF(Deq ic q oc)_(ic,q,oc)"
    5.15    Buffer_def:  "Buffer ic oc     == TEMP (EEX q. IBuffer ic q oc)"
    5.16  
    5.17 -ML {* use_legacy_bindings (the_context ()) *}
    5.18 +
    5.19 +(* ---------------------------- Data lemmas ---------------------------- *)
    5.20 +
    5.21 +(*FIXME: move to theory List? Maybe as (tl xs = xs) = (xs = [])"?*)
    5.22 +lemma tl_not_self [simp]: "xs ~= [] ==> tl xs ~= xs"
    5.23 +  by (auto simp: neq_Nil_conv)
    5.24 +
    5.25 +
    5.26 +(* ---------------------------- Action lemmas ---------------------------- *)
    5.27 +
    5.28 +(* Dequeue is visible *)
    5.29 +lemma Deq_visible: "|- <Deq ic q oc>_(ic,q,oc) = Deq ic q oc"
    5.30 +  apply (unfold angle_def Deq_def)
    5.31 +  apply (safe, simp (asm_lr))+
    5.32 +  done
    5.33 +
    5.34 +(* Enabling condition for dequeue -- NOT NEEDED *)
    5.35 +lemma Deq_enabled: 
    5.36 +    "!!q. basevars (ic,q,oc) ==> |- Enabled (<Deq ic q oc>_(ic,q,oc)) = (q ~= #[])"
    5.37 +  apply (unfold Deq_visible [temp_rewrite])
    5.38 +  apply (force elim!: base_enabled [temp_use] enabledE [temp_use] simp: Deq_def)
    5.39 +  done
    5.40 +
    5.41 +(* For the left-to-right implication, we don't need the base variable stuff *)
    5.42 +lemma Deq_enabledE: 
    5.43 +    "|- Enabled (<Deq ic q oc>_(ic,q,oc)) --> (q ~= #[])"
    5.44 +  apply (unfold Deq_visible [temp_rewrite])
    5.45 +  apply (auto elim!: enabledE simp add: Deq_def)
    5.46 +  done
    5.47  
    5.48  end
     6.1 --- a/src/HOL/TLA/Buffer/DBuffer.ML	Fri Dec 01 17:22:33 2006 +0100
     6.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.3 @@ -1,119 +0,0 @@
     6.4 -(*
     6.5 -    File:        DBuffer.ML
     6.6 -    ID:          $Id$
     6.7 -    Author:      Stephan Merz
     6.8 -    Copyright:   1997 University of Munich
     6.9 -
    6.10 -    Double FIFO buffer implements simple FIFO buffer.
    6.11 -*)
    6.12 -
    6.13 -
    6.14 -val db_css = (claset(), simpset() addsimps [qc_def]);
    6.15 -Addsimps [qc_def];
    6.16 -
    6.17 -val db_defs = [BInit_def, Enq_def, Deq_def, Next_def, IBuffer_def, Buffer_def,
    6.18 -               DBInit_def,DBEnq_def,DBDeq_def,DBPass_def,DBNext_def,DBuffer_def];
    6.19 -
    6.20 -
    6.21 -(*** Proper initialization ***)
    6.22 -Goal "|- Init DBInit --> Init (BInit inp qc out)";
    6.23 -by (auto_tac (db_css addsimps2 [Init_def,DBInit_def,BInit_def]));
    6.24 -qed "DBInit";
    6.25 -
    6.26 -
    6.27 -(*** Step simulation ***)
    6.28 -Goal "|- [DBNext]_(inp,mid,out,q1,q2) --> [Next inp qc out]_(inp,qc,out)";
    6.29 -by (rtac square_simulation 1);
    6.30 -by (Clarsimp_tac 1);
    6.31 -by (action_simp_tac (simpset() addsimps hd_append::db_defs) [] [] 1);
    6.32 -qed "DB_step_simulation";
    6.33 -
    6.34 -
    6.35 -(*** Simulation of fairness ***)
    6.36 -
    6.37 -(* Compute enabledness predicates for DBDeq and DBPass actions *)
    6.38 -Goalw [angle_def,DBDeq_def,Deq_def] "|- <DBDeq>_(inp,mid,out,q1,q2) = DBDeq";
    6.39 -by (REPEAT (Safe_tac THEN Asm_lr_simp_tac 1));
    6.40 -qed "DBDeq_visible";
    6.41 -
    6.42 -Goalw [action_rewrite DBDeq_visible]
    6.43 -  "|- Enabled (<DBDeq>_(inp,mid,out,q1,q2)) = (q2 ~= #[])";
    6.44 -by (force_tac (db_css addSIs2 [DB_base RS base_enabled] addSEs2 [enabledE]
    6.45 -                     addsimps2 [angle_def,DBDeq_def,Deq_def]) 1);
    6.46 -qed "DBDeq_enabled";
    6.47 -
    6.48 -Goal "|- <DBPass>_(inp,mid,out,q1,q2) = DBPass";
    6.49 -by (auto_tac (db_css addsimps2 [angle_def,DBPass_def,Deq_def]));
    6.50 -qed "DBPass_visible";
    6.51 -
    6.52 -Goalw [action_rewrite DBPass_visible]
    6.53 -   "|- Enabled (<DBPass>_(inp,mid,out,q1,q2)) = (q1 ~= #[])";
    6.54 -by (force_tac (db_css addSIs2 [DB_base RS base_enabled] addSEs2 [enabledE]
    6.55 -                     addsimps2 [angle_def,DBPass_def,Deq_def]) 1);
    6.56 -qed "DBPass_enabled";
    6.57 -
    6.58 -
    6.59 -(* The plan for proving weak fairness at the higher level is to prove
    6.60 -   (0)  DBuffer => (Enabled (Deq inp qc out) ~> (Deq inp qc out))
    6.61 -   which is in turn reduced to the two leadsto conditions
    6.62 -   (1)  DBuffer => (Enabled (Deq inp qc out) ~> q2 ~= [])
    6.63 -   (2)  DBuffer => (q2 ~= [] ~> DBDeq)
    6.64 -   and the fact that DBDeq implies <Deq inp qc out>_(inp,qc,out)
    6.65 -   (and therefore DBDeq ~> <Deq inp qc out>_(inp,qc,out) trivially holds).
    6.66 -
    6.67 -   Condition (1) is reduced to
    6.68 -   (1a) DBuffer => (qc ~= [] /\ q2 = [] ~> q2 ~= [])
    6.69 -   by standard leadsto rules (leadsto_classical) and rule Deq_enabledE.
    6.70 -
    6.71 -   Both (1a) and (2) are proved from DBuffer's WF conditions by standard
    6.72 -   WF reasoning (Lamport's WF1 and WF_leadsto).
    6.73 -   The condition WF(Deq inp qc out) follows from (0) by rule leadsto_WF.
    6.74 -
    6.75 -   One could use Lamport's WF2 instead.
    6.76 -*)
    6.77 -
    6.78 -(* Condition (1a) *)
    6.79 -Goal "|- [][DBNext]_(inp,mid,out,q1,q2) & WF(DBPass)_(inp,mid,out,q1,q2) \
    6.80 -\        --> (qc ~= #[] & q2 = #[] ~> q2 ~= #[])";
    6.81 -by (rtac WF1 1);
    6.82 -by (force_tac (db_css addsimps2 db_defs) 1);
    6.83 -by (force_tac (db_css addsimps2 [angle_def,DBPass_def]) 1);
    6.84 -by (force_tac (db_css addsimps2 [DBPass_enabled]) 1);
    6.85 -qed "DBFair_1a";
    6.86 -
    6.87 -(* Condition (1) *)
    6.88 -Goal "|- [][DBNext]_(inp,mid,out,q1,q2) & WF(DBPass)_(inp,mid,out,q1,q2) \
    6.89 -\        --> (Enabled (<Deq inp qc out>_(inp,qc,out)) ~> q2 ~= #[])";
    6.90 -by (Clarsimp_tac 1);
    6.91 -by (rtac (temp_use leadsto_classical) 1);
    6.92 -by (rtac ((temp_use DBFair_1a) RS (temp_use LatticeTransitivity)) 1);
    6.93 -by (TRYALL atac);
    6.94 -by (rtac (temp_use ImplLeadsto_gen) 1);
    6.95 -by (force_tac (db_css addSIs2 [necT] addSDs2 [STL2_gen, Deq_enabledE]
    6.96 -                      addsimps2 Init_defs) 1);
    6.97 -qed "DBFair_1";
    6.98 -
    6.99 -(* Condition (2) *)
   6.100 -Goal "|- [][DBNext]_(inp,mid,out,q1,q2) & WF(DBDeq)_(inp,mid,out,q1,q2) \
   6.101 -\        --> (q2 ~= #[] ~> DBDeq)";
   6.102 -by (rtac WF_leadsto 1);
   6.103 -by (force_tac (db_css addsimps2 [DBDeq_enabled]) 1);
   6.104 -by (force_tac (db_css addsimps2 [angle_def]) 1);
   6.105 -by (force_tac (db_css addsimps2 db_defs addSEs2 [Stable]) 1);
   6.106 -qed "DBFair_2";
   6.107 -
   6.108 -(* High-level fairness *)
   6.109 -Goal "|- [][DBNext]_(inp,mid,out,q1,q2) & WF(DBPass)_(inp,mid,out,q1,q2) \
   6.110 -\                                       & WF(DBDeq)_(inp,mid,out,q1,q2)  \
   6.111 -\        --> WF(Deq inp qc out)_(inp,qc,out)";
   6.112 -by (auto_tac (temp_css addSIs2 [leadsto_WF,
   6.113 -                                (temp_use DBFair_1) RSN(2,(temp_use LatticeTransitivity)),
   6.114 -                                (temp_use DBFair_2) RSN(2,(temp_use LatticeTransitivity))]));
   6.115 -by (auto_tac (db_css addSIs2 [ImplLeadsto_simple]
   6.116 -                     addsimps2 [angle_def,DBDeq_def,Deq_def,hd_append]));
   6.117 -qed "DBFair";
   6.118 -
   6.119 -(*** Main theorem ***)
   6.120 -Goalw [DBuffer_def,Buffer_def,IBuffer_def] "|- DBuffer --> Buffer inp out";
   6.121 -by (force_tac (temp_css addSIs2 [eexI,DBInit,DB_step_simulation RS STL4,DBFair]) 1);
   6.122 -qed "DBuffer_impl_Buffer";
     7.1 --- a/src/HOL/TLA/Buffer/DBuffer.thy	Fri Dec 01 17:22:33 2006 +0100
     7.2 +++ b/src/HOL/TLA/Buffer/DBuffer.thy	Sat Dec 02 02:52:02 2006 +0100
     7.3 @@ -3,9 +3,6 @@
     7.4      ID:          $Id$
     7.5      Author:      Stephan Merz
     7.6      Copyright:   1997 University of Munich
     7.7 -
     7.8 -   Theory Name: DBuffer
     7.9 -   Logic Image: TLA
    7.10  *)
    7.11  
    7.12  header {* Two FIFO buffers in a row, with interleaving assumption *}
    7.13 @@ -48,6 +45,119 @@
    7.14                                   & WF(DBDeq)_(inp,mid,out,q1,q2)
    7.15                                   & WF(DBPass)_(inp,mid,out,q1,q2)"
    7.16  
    7.17 -ML {* use_legacy_bindings (the_context ()) *}
    7.18 +
    7.19 +declare qc_def [simp]
    7.20 +
    7.21 +lemmas db_defs =
    7.22 +  BInit_def Enq_def Deq_def Next_def IBuffer_def Buffer_def
    7.23 +  DBInit_def DBEnq_def DBDeq_def DBPass_def DBNext_def DBuffer_def
    7.24 +
    7.25 +
    7.26 +(*** Proper initialization ***)
    7.27 +lemma DBInit: "|- Init DBInit --> Init (BInit inp qc out)"
    7.28 +  by (auto simp: Init_def DBInit_def BInit_def)
    7.29 +
    7.30 +
    7.31 +(*** Step simulation ***)
    7.32 +lemma DB_step_simulation: "|- [DBNext]_(inp,mid,out,q1,q2) --> [Next inp qc out]_(inp,qc,out)"
    7.33 +  apply (rule square_simulation)
    7.34 +   apply clarsimp
    7.35 +  apply (tactic
    7.36 +    {* action_simp_tac (simpset () addsimps (thm "hd_append" :: thms "db_defs")) [] [] 1 *})
    7.37 +  done
    7.38 +
    7.39 +
    7.40 +(*** Simulation of fairness ***)
    7.41 +
    7.42 +(* Compute enabledness predicates for DBDeq and DBPass actions *)
    7.43 +lemma DBDeq_visible: "|- <DBDeq>_(inp,mid,out,q1,q2) = DBDeq"
    7.44 +  apply (unfold angle_def DBDeq_def Deq_def)
    7.45 +  apply (safe, simp (asm_lr))+
    7.46 +  done
    7.47 +
    7.48 +lemma DBDeq_enabled: 
    7.49 +    "|- Enabled (<DBDeq>_(inp,mid,out,q1,q2)) = (q2 ~= #[])"
    7.50 +  apply (unfold DBDeq_visible [action_rewrite])
    7.51 +  apply (force intro!: DB_base [THEN base_enabled, temp_use]
    7.52 +    elim!: enabledE simp: angle_def DBDeq_def Deq_def)
    7.53 +  done
    7.54 +
    7.55 +lemma DBPass_visible: "|- <DBPass>_(inp,mid,out,q1,q2) = DBPass"
    7.56 +  by (auto simp: angle_def DBPass_def Deq_def)
    7.57 +
    7.58 +lemma DBPass_enabled: 
    7.59 +    "|- Enabled (<DBPass>_(inp,mid,out,q1,q2)) = (q1 ~= #[])"
    7.60 +  apply (unfold DBPass_visible [action_rewrite])
    7.61 +  apply (force intro!: DB_base [THEN base_enabled, temp_use]
    7.62 +    elim!: enabledE simp: angle_def DBPass_def Deq_def)
    7.63 +  done
    7.64 +
    7.65 +
    7.66 +(* The plan for proving weak fairness at the higher level is to prove
    7.67 +   (0)  DBuffer => (Enabled (Deq inp qc out) ~> (Deq inp qc out))
    7.68 +   which is in turn reduced to the two leadsto conditions
    7.69 +   (1)  DBuffer => (Enabled (Deq inp qc out) ~> q2 ~= [])
    7.70 +   (2)  DBuffer => (q2 ~= [] ~> DBDeq)
    7.71 +   and the fact that DBDeq implies <Deq inp qc out>_(inp,qc,out)
    7.72 +   (and therefore DBDeq ~> <Deq inp qc out>_(inp,qc,out) trivially holds).
    7.73  
    7.74 -end
    7.75 \ No newline at end of file
    7.76 +   Condition (1) is reduced to
    7.77 +   (1a) DBuffer => (qc ~= [] /\ q2 = [] ~> q2 ~= [])
    7.78 +   by standard leadsto rules (leadsto_classical) and rule Deq_enabledE.
    7.79 +
    7.80 +   Both (1a) and (2) are proved from DBuffer's WF conditions by standard
    7.81 +   WF reasoning (Lamport's WF1 and WF_leadsto).
    7.82 +   The condition WF(Deq inp qc out) follows from (0) by rule leadsto_WF.
    7.83 +
    7.84 +   One could use Lamport's WF2 instead.
    7.85 +*)
    7.86 +
    7.87 +(* Condition (1a) *)
    7.88 +lemma DBFair_1a: "|- [][DBNext]_(inp,mid,out,q1,q2) & WF(DBPass)_(inp,mid,out,q1,q2)  
    7.89 +         --> (qc ~= #[] & q2 = #[] ~> q2 ~= #[])"
    7.90 +  apply (rule WF1)
    7.91 +    apply (force simp: db_defs)
    7.92 +   apply (force simp: angle_def DBPass_def)
    7.93 +  apply (force simp: DBPass_enabled [temp_use])
    7.94 +  done
    7.95 +
    7.96 +(* Condition (1) *)
    7.97 +lemma DBFair_1: "|- [][DBNext]_(inp,mid,out,q1,q2) & WF(DBPass)_(inp,mid,out,q1,q2)  
    7.98 +         --> (Enabled (<Deq inp qc out>_(inp,qc,out)) ~> q2 ~= #[])"
    7.99 +  apply clarsimp
   7.100 +  apply (rule leadsto_classical [temp_use])
   7.101 +  apply (rule DBFair_1a [temp_use, THEN LatticeTransitivity [temp_use]])
   7.102 +  apply assumption+
   7.103 +  apply (rule ImplLeadsto_gen [temp_use])
   7.104 +  apply (force intro!: necT [temp_use] dest!: STL2_gen [temp_use] Deq_enabledE [temp_use]
   7.105 +    simp add: Init_defs)
   7.106 +  done
   7.107 +
   7.108 +(* Condition (2) *)
   7.109 +lemma DBFair_2: "|- [][DBNext]_(inp,mid,out,q1,q2) & WF(DBDeq)_(inp,mid,out,q1,q2)  
   7.110 +         --> (q2 ~= #[] ~> DBDeq)"
   7.111 +  apply (rule WF_leadsto)
   7.112 +    apply (force simp: DBDeq_enabled [temp_use])
   7.113 +   apply (force simp: angle_def)
   7.114 +  apply (force simp: db_defs elim!: Stable [temp_use])
   7.115 +  done
   7.116 +
   7.117 +(* High-level fairness *)
   7.118 +lemma DBFair: "|- [][DBNext]_(inp,mid,out,q1,q2) & WF(DBPass)_(inp,mid,out,q1,q2)  
   7.119 +                                        & WF(DBDeq)_(inp,mid,out,q1,q2)   
   7.120 +         --> WF(Deq inp qc out)_(inp,qc,out)"
   7.121 +  apply (auto simp del: qc_def intro!: leadsto_WF [temp_use]
   7.122 +    DBFair_1 [temp_use, THEN [2] LatticeTransitivity [temp_use]]
   7.123 +    DBFair_2 [temp_use, THEN [2] LatticeTransitivity [temp_use]])
   7.124 +  apply (auto intro!: ImplLeadsto_simple [temp_use]
   7.125 +    simp: angle_def DBDeq_def Deq_def hd_append [try_rewrite])
   7.126 +  done
   7.127 +
   7.128 +(*** Main theorem ***)
   7.129 +lemma DBuffer_impl_Buffer: "|- DBuffer --> Buffer inp out"
   7.130 +  apply (unfold DBuffer_def Buffer_def IBuffer_def)
   7.131 +  apply (force intro!: eexI [temp_use] DBInit [temp_use]
   7.132 +    DB_step_simulation [THEN STL4, temp_use] DBFair [temp_use])
   7.133 +  done
   7.134 +
   7.135 +end
     8.1 --- a/src/HOL/TLA/Inc/Inc.ML	Fri Dec 01 17:22:33 2006 +0100
     8.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     8.3 @@ -1,244 +0,0 @@
     8.4 -(*
     8.5 -    File:        TLA/ex/inc/Inc.ML
     8.6 -    ID:          $Id$
     8.7 -    Author:      Stephan Merz
     8.8 -    Copyright:   1997 University of Munich
     8.9 -
    8.10 -Proofs for the "increment" example from SRC79.
    8.11 -*)
    8.12 -
    8.13 -val PsiInv_defs = [PsiInv_def,PsiInv1_def,PsiInv2_def,PsiInv3_def];
    8.14 -val Psi_defs = [Psi_def,InitPsi_def,N1_def,N2_def,alpha1_def,alpha2_def,
    8.15 -                beta1_def,beta2_def,gamma1_def,gamma2_def];
    8.16 -
    8.17 -val Inc_css = (claset(), simpset());
    8.18 -
    8.19 -(*** Invariant proof for Psi: "manual" proof proves individual lemmas ***)
    8.20 -
    8.21 -Goal "|- InitPsi --> PsiInv";
    8.22 -by (auto_tac (Inc_css addsimps2 InitPsi_def::PsiInv_defs));
    8.23 -qed "PsiInv_Init";
    8.24 -
    8.25 -Goal "|- alpha1 & $PsiInv --> PsiInv$";
    8.26 -by (auto_tac (Inc_css addsimps2 alpha1_def::PsiInv_defs));
    8.27 -qed "PsiInv_alpha1";
    8.28 -
    8.29 -Goal "|- alpha2 & $PsiInv --> PsiInv$";
    8.30 -by (auto_tac (Inc_css addsimps2 alpha2_def::PsiInv_defs));
    8.31 -qed "PsiInv_alpha2";
    8.32 -
    8.33 -Goal "|- beta1 & $PsiInv --> PsiInv$";
    8.34 -by (auto_tac (Inc_css addsimps2 beta1_def::PsiInv_defs));
    8.35 -qed "PsiInv_beta1";
    8.36 -
    8.37 -Goal "|- beta2 & $PsiInv --> PsiInv$";
    8.38 -by (auto_tac (Inc_css addsimps2 beta2_def::PsiInv_defs));
    8.39 -qed "PsiInv_beta2";
    8.40 -
    8.41 -Goal "|- gamma1 & $PsiInv --> PsiInv$";
    8.42 -by (auto_tac (Inc_css addsimps2 gamma1_def::PsiInv_defs));
    8.43 -qed "PsiInv_gamma1";
    8.44 -
    8.45 -Goal "|- gamma2 & $PsiInv --> PsiInv$";
    8.46 -by (auto_tac (Inc_css addsimps2 gamma2_def::PsiInv_defs));
    8.47 -qed "PsiInv_gamma2";
    8.48 -
    8.49 -Goal "|- unchanged (x,y,sem,pc1,pc2) & $PsiInv --> PsiInv$";
    8.50 -by (auto_tac (Inc_css addsimps2 PsiInv_defs));
    8.51 -qed "PsiInv_stutter";
    8.52 -
    8.53 -Goal "|- Psi --> []PsiInv";
    8.54 -by (inv_tac (Inc_css addsimps2 [Psi_def]) 1);
    8.55 - by (force_tac (Inc_css addsimps2 [PsiInv_Init, Init_def]) 1);
    8.56 -by (auto_tac (Inc_css
    8.57 -              addIs2 [PsiInv_alpha1,PsiInv_alpha2,PsiInv_beta1,
    8.58 -                      PsiInv_beta2,PsiInv_gamma1,PsiInv_gamma2,PsiInv_stutter]
    8.59 -              addsimps2 [square_def,N1_def, N2_def]));
    8.60 -qed "PsiInv";
    8.61 -
    8.62 -(* Automatic proof works too, but it make take a while on a slow machine.
    8.63 -   More realistic examples require user guidance anyway.
    8.64 -
    8.65 -Goal "|- Psi --> []PsiInv";
    8.66 -by (auto_inv_tac (simpset() addsimps PsiInv_defs @ Psi_defs) 1);
    8.67 -
    8.68 -*)
    8.69 -
    8.70 -(**** Step simulation ****)
    8.71 -
    8.72 -Goal "|- Psi --> Init InitPhi";
    8.73 -by (auto_tac (Inc_css addsimps2 [InitPhi_def,Psi_def,InitPsi_def,Init_def]));
    8.74 -qed "Init_sim";
    8.75 -
    8.76 -Goal "|- Psi --> [][M1 | M2]_(x,y)";
    8.77 -by (auto_tac (Inc_css addsimps2 [square_def,M1_def,M2_def] @ Psi_defs
    8.78 -                      addSEs2 [STL4E]));
    8.79 -qed "Step_sim";
    8.80 -
    8.81 -(**** Proof of fairness ****)
    8.82 -
    8.83 -(*
    8.84 -   The goal is to prove Fair_M1 far below, which asserts
    8.85 -         |- Psi --> WF(M1)_(x,y)
    8.86 -   (the other fairness condition is symmetrical).
    8.87 -
    8.88 -   The strategy is to use WF2 (with beta1 as the helpful action). Proving its
    8.89 -   temporal premise needs two auxiliary lemmas:
    8.90 -   1. Stuck_at_b: control can only proceed at pc1 = b by executing beta1
    8.91 -   2. N1_live: the first component will eventually reach b
    8.92 -
    8.93 -   Lemma 1 is easy, lemma 2 relies on the invariant, the strong fairness
    8.94 -   of the semaphore, and needs auxiliary lemmas that ensure that the second
    8.95 -   component will eventually release the semaphore. Most of the proofs of
    8.96 -   the auxiliary lemmas are very similar.
    8.97 -*)
    8.98 -
    8.99 -Goal "|- [][(N1 | N2) & ~ beta1]_(x,y,sem,pc1,pc2) --> stable(pc1 = #b)";
   8.100 -by (auto_tac (Inc_css addSEs2 [Stable,squareE] addsimps2 Psi_defs));
   8.101 -qed "Stuck_at_b";
   8.102 -
   8.103 -Goal "|- pc1 = #g --> Enabled (<N1>_(x,y,sem,pc1,pc2))";
   8.104 -by (Clarsimp_tac 1);
   8.105 -by (res_inst_tac [("F","gamma1")] enabled_mono 1);
   8.106 -by (enabled_tac Inc_base 1);
   8.107 - by (force_tac (Inc_css addsimps2 [gamma1_def]) 1);
   8.108 -by (force_tac (Inc_css addsimps2 [angle_def,gamma1_def,N1_def]) 1);
   8.109 -qed "N1_enabled_at_g";
   8.110 -
   8.111 -Goal "|- [][(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2) & SF(N1)_(x,y,sem,pc1,pc2) & []#True \
   8.112 -\        --> (pc1 = #g ~> pc1 = #a)";
   8.113 -by (rtac SF1 1);
   8.114 -by (action_simp_tac (simpset() addsimps Psi_defs) [] [squareE] 1);
   8.115 -by (action_simp_tac (simpset() addsimps angle_def::Psi_defs) [] [] 1);
   8.116 -(* reduce |- []A --> <>Enabled B  to  |- A --> Enabled B *)
   8.117 -by (auto_tac (Inc_css addSIs2 [InitDmd_gen, N1_enabled_at_g]
   8.118 -                      addSDs2 [STL2_gen]
   8.119 -                      addsimps2 [Init_def]));
   8.120 -qed "g1_leadsto_a1";
   8.121 -
   8.122 -(* symmetrical for N2, and similar for beta2 *)
   8.123 -Goal "|- pc2 = #g --> Enabled (<N2>_(x,y,sem,pc1,pc2))";
   8.124 -by (Clarsimp_tac 1);
   8.125 -by (res_inst_tac [("F","gamma2")] enabled_mono 1);
   8.126 -by (enabled_tac Inc_base 1);
   8.127 - by (force_tac (Inc_css addsimps2 [gamma2_def]) 1);
   8.128 -by (force_tac (Inc_css addsimps2 [angle_def,gamma2_def,N2_def]) 1);
   8.129 -qed "N2_enabled_at_g";
   8.130 -
   8.131 -Goal "|- [][(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2) & SF(N2)_(x,y,sem,pc1,pc2) & []#True \
   8.132 -\        --> (pc2 = #g ~> pc2 = #a)";
   8.133 -by (rtac SF1 1);
   8.134 -by (action_simp_tac (simpset() addsimps Psi_defs) [] [squareE] 1);
   8.135 -by (action_simp_tac (simpset() addsimps angle_def::Psi_defs) [] [] 1);
   8.136 -by (auto_tac (Inc_css addSIs2 [InitDmd_gen, N2_enabled_at_g]
   8.137 -                      addSDs2 [STL2_gen]
   8.138 -                      addsimps2 [Init_def]));
   8.139 -qed "g2_leadsto_a2";
   8.140 -
   8.141 -Goal "|- pc2 = #b --> Enabled (<N2>_(x,y,sem,pc1,pc2))";
   8.142 -by (Clarsimp_tac 1);
   8.143 -by (res_inst_tac [("F","beta2")] enabled_mono 1);
   8.144 -by (enabled_tac Inc_base 1);
   8.145 - by (force_tac (Inc_css addsimps2 [beta2_def]) 1);
   8.146 -by (force_tac (Inc_css addsimps2 [angle_def,beta2_def,N2_def]) 1);
   8.147 -qed "N2_enabled_at_b";
   8.148 -
   8.149 -Goal "|- [][(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2) & SF(N2)_(x,y,sem,pc1,pc2) & []#True \
   8.150 -\        --> (pc2 = #b ~> pc2 = #g)";
   8.151 -by (rtac SF1 1);
   8.152 -by (action_simp_tac (simpset() addsimps Psi_defs) [] [squareE] 1);
   8.153 -by (action_simp_tac (simpset() addsimps angle_def::Psi_defs) [] [] 1);
   8.154 -by (auto_tac (Inc_css addSIs2 [InitDmd_gen, N2_enabled_at_b]
   8.155 -                      addSDs2 [STL2_gen]
   8.156 -                      addsimps2 [Init_def]));
   8.157 -qed "b2_leadsto_g2";
   8.158 -
   8.159 -(* Combine above lemmas: the second component will eventually reach pc2 = a *)
   8.160 -Goal "|- [][(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2) & SF(N2)_(x,y,sem,pc1,pc2) & []#True \
   8.161 -\        --> (pc2 = #a | pc2 = #b | pc2 = #g ~> pc2 = #a)";
   8.162 -by (auto_tac (Inc_css addSIs2 [LatticeDisjunctionIntro]));
   8.163 -by (rtac (temp_use LatticeReflexivity) 1);
   8.164 -by (rtac (temp_use LatticeTransitivity) 1);
   8.165 -by (auto_tac (Inc_css addSIs2 [b2_leadsto_g2,g2_leadsto_a2]));
   8.166 -qed "N2_leadsto_a";
   8.167 -
   8.168 -(* Get rid of disjunction on the left-hand side of ~> above. *)
   8.169 -Goal "|- [][(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2) & SF(N2)_(x,y,sem,pc1,pc2) \
   8.170 -\        --> <>(pc2 = #a)";
   8.171 -by (auto_tac (Inc_css addsimps2 Init_defs
   8.172 -                      addSIs2 [(temp_use N2_leadsto_a)
   8.173 -                               RSN(2, (temp_use leadsto_init))]));
   8.174 -by (case_tac "pc2 (st1 sigma)" 1);
   8.175 -by Auto_tac;
   8.176 -qed "N2_live";
   8.177 -
   8.178 -(* Now prove that the first component will eventually reach pc1 = b from pc1 = a *)
   8.179 -
   8.180 -Goal "|- pc2 = #a & (PsiInv & pc1 = #a) --> Enabled (<N1>_(x,y,sem,pc1,pc2))";
   8.181 -by (Clarsimp_tac 1);
   8.182 -by (res_inst_tac [("F","alpha1")] enabled_mono 1);
   8.183 -by (enabled_tac Inc_base 1);
   8.184 - by (force_tac (Inc_css addsimps2 (alpha1_def::PsiInv_defs)) 1);
   8.185 -by (force_tac (Inc_css addsimps2 [angle_def,alpha1_def,N1_def]) 1);
   8.186 -qed "N1_enabled_at_both_a";
   8.187 -
   8.188 -Goal "|- []($PsiInv & [(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2))      \
   8.189 -\        & SF(N1)_(x,y,sem,pc1,pc2) & [] SF(N2)_(x,y,sem,pc1,pc2)  \
   8.190 -\        --> (pc1 = #a ~> pc1 = #b)";
   8.191 -by (rtac SF1 1);
   8.192 -by (action_simp_tac (simpset() addsimps Psi_defs) [] [squareE] 1);
   8.193 -by (action_simp_tac (simpset() addsimps angle_def::Psi_defs) [] [] 1);
   8.194 -by (clarsimp_tac (Inc_css addSIs2 [N1_enabled_at_both_a RS (temp_use DmdImpl)]) 1);
   8.195 -by (auto_tac (Inc_css addSIs2 [BoxDmd2_simple, N2_live]
   8.196 -                      addsimps2 split_box_conj::more_temp_simps));
   8.197 -qed "a1_leadsto_b1";
   8.198 -
   8.199 -(* Combine the leadsto properties for N1: it will arrive at pc1 = b *)
   8.200 -
   8.201 -Goal "|- []($PsiInv & [(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2))             \
   8.202 -\        & SF(N1)_(x,y,sem,pc1,pc2) & [] SF(N2)_(x,y,sem,pc1,pc2)  \
   8.203 -\        --> (pc1 = #b | pc1 = #g | pc1 = #a ~> pc1 = #b)";
   8.204 -by (auto_tac (Inc_css addSIs2 [LatticeDisjunctionIntro]));
   8.205 -by (rtac (temp_use LatticeReflexivity) 1);
   8.206 -by (rtac (temp_use LatticeTransitivity) 1);
   8.207 -by (auto_tac (Inc_css addSIs2 [a1_leadsto_b1,g1_leadsto_a1]
   8.208 -                      addsimps2 [split_box_conj]));
   8.209 -qed "N1_leadsto_b";
   8.210 -
   8.211 -Goal "|- []($PsiInv & [(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2))             \
   8.212 -\        & SF(N1)_(x,y,sem,pc1,pc2) & [] SF(N2)_(x,y,sem,pc1,pc2)  \
   8.213 -\        --> <>(pc1 = #b)";
   8.214 -by (auto_tac (Inc_css addsimps2 Init_defs
   8.215 -                      addSIs2 [(temp_use N1_leadsto_b)
   8.216 -                               RSN(2, temp_use leadsto_init)]));
   8.217 -by (case_tac "pc1 (st1 sigma)" 1);
   8.218 -by Auto_tac;
   8.219 -qed "N1_live";
   8.220 -
   8.221 -Goal "|- pc1 = #b --> Enabled (<N1>_(x,y,sem,pc1,pc2))";
   8.222 -by (Clarsimp_tac 1);
   8.223 -by (res_inst_tac [("F","beta1")] enabled_mono 1);
   8.224 -by (enabled_tac Inc_base 1);
   8.225 - by (force_tac (Inc_css addsimps2 [beta1_def]) 1);
   8.226 -by (force_tac (Inc_css addsimps2 [angle_def,beta1_def,N1_def]) 1);
   8.227 -qed "N1_enabled_at_b";
   8.228 -
   8.229 -(* Now assemble the bits and pieces to prove that Psi is fair. *)
   8.230 -
   8.231 -Goal "|- []($PsiInv & [(N1 | N2)]_(x,y,sem,pc1,pc2))   \
   8.232 -\        & SF(N1)_(x,y,sem,pc1,pc2) & []SF(N2)_(x,y,sem,pc1,pc2)  \
   8.233 -\        --> SF(M1)_(x,y)";
   8.234 -by (res_inst_tac [("B","beta1"),("P","PRED pc1 = #b")] SF2 1);
   8.235 -   (* action premises *)
   8.236 -by (force_tac (Inc_css addsimps2 [angle_def,M1_def,beta1_def]) 1);
   8.237 -by (force_tac (Inc_css addsimps2 angle_def::Psi_defs) 1);
   8.238 -by (force_tac (Inc_css addSEs2 [N1_enabled_at_b]) 1);
   8.239 -   (* temporal premise: use previous lemmas and simple TL *)
   8.240 -by (force_tac (Inc_css addSIs2 [DmdStable, N1_live,Stuck_at_b]
   8.241 -                       addEs2 [STL4E] addsimps2 [square_def]) 1);
   8.242 -qed "Fair_M1_lemma";
   8.243 -
   8.244 -Goal "|- Psi --> WF(M1)_(x,y)";
   8.245 -by (auto_tac (Inc_css addSIs2 [SFImplWF, Fair_M1_lemma, PsiInv]
   8.246 -                      addsimps2 [Psi_def,split_box_conj]@more_temp_simps));
   8.247 -qed "Fair_M1";
     9.1 --- a/src/HOL/TLA/Inc/Inc.thy	Fri Dec 01 17:22:33 2006 +0100
     9.2 +++ b/src/HOL/TLA/Inc/Inc.thy	Sat Dec 02 02:52:02 2006 +0100
     9.3 @@ -3,9 +3,6 @@
     9.4      ID:          $Id$
     9.5      Author:      Stephan Merz
     9.6      Copyright:   1997 University of Munich
     9.7 -
     9.8 -    Theory Name: Inc
     9.9 -    Logic Image: TLA    
    9.10  *)
    9.11  
    9.12  header {* Lamport's "increment" example *}
    9.13 @@ -85,6 +82,234 @@
    9.14    PsiInv3_def:  "PsiInv3  == PRED sem = # 0 & pc2 = #a & (pc1 = #b | pc1 = #g)"
    9.15    PsiInv_def:   "PsiInv   == PRED (PsiInv1 | PsiInv2 | PsiInv3)"
    9.16  
    9.17 -ML {* use_legacy_bindings (the_context ()) *}
    9.18 +
    9.19 +lemmas PsiInv_defs = PsiInv_def PsiInv1_def PsiInv2_def PsiInv3_def
    9.20 +lemmas Psi_defs = Psi_def InitPsi_def N1_def N2_def alpha1_def alpha2_def
    9.21 +  beta1_def beta2_def gamma1_def gamma2_def
    9.22 +
    9.23 +
    9.24 +(*** Invariant proof for Psi: "manual" proof proves individual lemmas ***)
    9.25 +
    9.26 +lemma PsiInv_Init: "|- InitPsi --> PsiInv"
    9.27 +  by (auto simp: InitPsi_def PsiInv_defs)
    9.28 +
    9.29 +lemma PsiInv_alpha1: "|- alpha1 & $PsiInv --> PsiInv$"
    9.30 +  by (auto simp: alpha1_def PsiInv_defs)
    9.31 +
    9.32 +lemma PsiInv_alpha2: "|- alpha2 & $PsiInv --> PsiInv$"
    9.33 +  by (auto simp: alpha2_def PsiInv_defs)
    9.34 +
    9.35 +lemma PsiInv_beta1: "|- beta1 & $PsiInv --> PsiInv$"
    9.36 +  by (auto simp: beta1_def PsiInv_defs)
    9.37 +
    9.38 +lemma PsiInv_beta2: "|- beta2 & $PsiInv --> PsiInv$"
    9.39 +  by (auto simp: beta2_def PsiInv_defs)
    9.40 +
    9.41 +lemma PsiInv_gamma1: "|- gamma1 & $PsiInv --> PsiInv$"
    9.42 +  by (auto simp: gamma1_def PsiInv_defs)
    9.43 +
    9.44 +lemma PsiInv_gamma2: "|- gamma2 & $PsiInv --> PsiInv$"
    9.45 +  by (auto simp: gamma2_def PsiInv_defs)
    9.46 +
    9.47 +lemma PsiInv_stutter: "|- unchanged (x,y,sem,pc1,pc2) & $PsiInv --> PsiInv$"
    9.48 +  by (auto simp: PsiInv_defs)
    9.49 +
    9.50 +lemma PsiInv: "|- Psi --> []PsiInv"
    9.51 +  apply (tactic {* inv_tac (clasimpset () addsimps2 [thm "Psi_def"]) 1 *})
    9.52 +   apply (force simp: PsiInv_Init [try_rewrite] Init_def)
    9.53 +  apply (auto intro: PsiInv_alpha1 [try_rewrite] PsiInv_alpha2 [try_rewrite]
    9.54 +    PsiInv_beta1 [try_rewrite] PsiInv_beta2 [try_rewrite] PsiInv_gamma1 [try_rewrite]
    9.55 +    PsiInv_gamma2 [try_rewrite] PsiInv_stutter [try_rewrite]
    9.56 +    simp add: square_def N1_def N2_def)
    9.57 +  done
    9.58 +
    9.59 +(* Automatic proof works too, but it make take a while on a slow machine.
    9.60 +   More realistic examples require user guidance anyway.
    9.61 +*)
    9.62 +
    9.63 +lemma "|- Psi --> []PsiInv"
    9.64 +  by (tactic {* auto_inv_tac (simpset() addsimps (thms "PsiInv_defs" @ thms "Psi_defs")) 1 *})
    9.65 +
    9.66 +
    9.67 +(**** Step simulation ****)
    9.68 +
    9.69 +lemma Init_sim: "|- Psi --> Init InitPhi"
    9.70 +  by (auto simp: InitPhi_def Psi_def InitPsi_def Init_def)
    9.71 +
    9.72 +lemma Step_sim: "|- Psi --> [][M1 | M2]_(x,y)"
    9.73 +  by (auto simp: square_def M1_def M2_def Psi_defs elim!: STL4E [temp_use])
    9.74 +
    9.75 +
    9.76 +(**** Proof of fairness ****)
    9.77 +
    9.78 +(*
    9.79 +   The goal is to prove Fair_M1 far below, which asserts
    9.80 +         |- Psi --> WF(M1)_(x,y)
    9.81 +   (the other fairness condition is symmetrical).
    9.82 +
    9.83 +   The strategy is to use WF2 (with beta1 as the helpful action). Proving its
    9.84 +   temporal premise needs two auxiliary lemmas:
    9.85 +   1. Stuck_at_b: control can only proceed at pc1 = b by executing beta1
    9.86 +   2. N1_live: the first component will eventually reach b
    9.87 +
    9.88 +   Lemma 1 is easy, lemma 2 relies on the invariant, the strong fairness
    9.89 +   of the semaphore, and needs auxiliary lemmas that ensure that the second
    9.90 +   component will eventually release the semaphore. Most of the proofs of
    9.91 +   the auxiliary lemmas are very similar.
    9.92 +*)
    9.93 +
    9.94 +lemma Stuck_at_b: "|- [][(N1 | N2) & ~ beta1]_(x,y,sem,pc1,pc2) --> stable(pc1 = #b)"
    9.95 +  by (auto elim!: Stable squareE simp: Psi_defs)
    9.96 +
    9.97 +lemma N1_enabled_at_g: "|- pc1 = #g --> Enabled (<N1>_(x,y,sem,pc1,pc2))"
    9.98 +  apply clarsimp
    9.99 +  apply (rule_tac F = gamma1 in enabled_mono)
   9.100 +   apply (tactic {* enabled_tac (thm "Inc_base") 1 *})
   9.101 +  apply (force simp: gamma1_def)
   9.102 +  apply (force simp: angle_def gamma1_def N1_def)
   9.103 +  done
   9.104 +
   9.105 +lemma g1_leadsto_a1:
   9.106 +  "|- [][(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2) & SF(N1)_(x,y,sem,pc1,pc2) & []#True  
   9.107 +    --> (pc1 = #g ~> pc1 = #a)"
   9.108 +  apply (rule SF1)
   9.109 +    apply (tactic
   9.110 +      {* action_simp_tac (simpset () addsimps (thms "Psi_defs")) [] [thm "squareE"] 1 *})
   9.111 +   apply (tactic
   9.112 +      {* action_simp_tac (simpset () addsimps (thm "angle_def" :: thms "Psi_defs")) [] [] 1 *})
   9.113 +  (* reduce |- []A --> <>Enabled B  to  |- A --> Enabled B *)
   9.114 +  apply (auto intro!: InitDmd_gen [temp_use] N1_enabled_at_g [temp_use]
   9.115 +    dest!: STL2_gen [temp_use] simp: Init_def)
   9.116 +  done
   9.117 +
   9.118 +(* symmetrical for N2, and similar for beta2 *)
   9.119 +lemma N2_enabled_at_g: "|- pc2 = #g --> Enabled (<N2>_(x,y,sem,pc1,pc2))"
   9.120 +  apply clarsimp
   9.121 +  apply (rule_tac F = gamma2 in enabled_mono)
   9.122 +  apply (tactic {* enabled_tac (thm "Inc_base") 1 *})
   9.123 +   apply (force simp: gamma2_def)
   9.124 +  apply (force simp: angle_def gamma2_def N2_def)
   9.125 +  done
   9.126 +
   9.127 +lemma g2_leadsto_a2:
   9.128 +  "|- [][(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2) & SF(N2)_(x,y,sem,pc1,pc2) & []#True  
   9.129 +    --> (pc2 = #g ~> pc2 = #a)"
   9.130 +  apply (rule SF1)
   9.131 +  apply (tactic {* action_simp_tac (simpset () addsimps (thms "Psi_defs")) [] [thm "squareE"] 1 *})
   9.132 +  apply (tactic {* action_simp_tac (simpset () addsimps (thm "angle_def" :: thms "Psi_defs"))
   9.133 +    [] [] 1 *})
   9.134 +  apply (auto intro!: InitDmd_gen [temp_use] N2_enabled_at_g [temp_use]
   9.135 +    dest!: STL2_gen [temp_use] simp add: Init_def)
   9.136 +  done
   9.137 +
   9.138 +lemma N2_enabled_at_b: "|- pc2 = #b --> Enabled (<N2>_(x,y,sem,pc1,pc2))"
   9.139 +  apply clarsimp
   9.140 +  apply (rule_tac F = beta2 in enabled_mono)
   9.141 +   apply (tactic {* enabled_tac (thm "Inc_base") 1 *})
   9.142 +   apply (force simp: beta2_def)
   9.143 +  apply (force simp: angle_def beta2_def N2_def)
   9.144 +  done
   9.145 +
   9.146 +lemma b2_leadsto_g2:
   9.147 +  "|- [][(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2) & SF(N2)_(x,y,sem,pc1,pc2) & []#True  
   9.148 +    --> (pc2 = #b ~> pc2 = #g)"
   9.149 +  apply (rule SF1)
   9.150 +    apply (tactic
   9.151 +      {* action_simp_tac (simpset () addsimps (thms "Psi_defs")) [] [thm "squareE"] 1 *})
   9.152 +   apply (tactic
   9.153 +     {* action_simp_tac (simpset () addsimps (thm "angle_def" :: thms "Psi_defs")) [] [] 1 *})
   9.154 +  apply (auto intro!: InitDmd_gen [temp_use] N2_enabled_at_b [temp_use]
   9.155 +    dest!: STL2_gen [temp_use] simp: Init_def)
   9.156 +  done
   9.157 +
   9.158 +(* Combine above lemmas: the second component will eventually reach pc2 = a *)
   9.159 +lemma N2_leadsto_a:
   9.160 +  "|- [][(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2) & SF(N2)_(x,y,sem,pc1,pc2) & []#True  
   9.161 +    --> (pc2 = #a | pc2 = #b | pc2 = #g ~> pc2 = #a)"
   9.162 +  apply (auto intro!: LatticeDisjunctionIntro [temp_use])
   9.163 +    apply (rule LatticeReflexivity [temp_use])
   9.164 +   apply (rule LatticeTransitivity [temp_use])
   9.165 +  apply (auto intro!: b2_leadsto_g2 [temp_use] g2_leadsto_a2 [temp_use])
   9.166 +  done
   9.167 +
   9.168 +(* Get rid of disjunction on the left-hand side of ~> above. *)
   9.169 +lemma N2_live:
   9.170 +  "|- [][(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2) & SF(N2)_(x,y,sem,pc1,pc2)  
   9.171 +    --> <>(pc2 = #a)"
   9.172 +  apply (auto simp: Init_defs intro!: N2_leadsto_a [temp_use, THEN [2] leadsto_init [temp_use]])
   9.173 +  apply (case_tac "pc2 (st1 sigma)")
   9.174 +    apply auto
   9.175 +  done
   9.176 +
   9.177 +(* Now prove that the first component will eventually reach pc1 = b from pc1 = a *)
   9.178 +
   9.179 +lemma N1_enabled_at_both_a:
   9.180 +  "|- pc2 = #a & (PsiInv & pc1 = #a) --> Enabled (<N1>_(x,y,sem,pc1,pc2))"
   9.181 +  apply clarsimp
   9.182 +  apply (rule_tac F = alpha1 in enabled_mono)
   9.183 +  apply (tactic {* enabled_tac (thm "Inc_base") 1 *})
   9.184 +   apply (force simp: alpha1_def PsiInv_defs)
   9.185 +  apply (force simp: angle_def alpha1_def N1_def)
   9.186 +  done
   9.187 +
   9.188 +lemma a1_leadsto_b1:
   9.189 +  "|- []($PsiInv & [(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2))       
   9.190 +         & SF(N1)_(x,y,sem,pc1,pc2) & [] SF(N2)_(x,y,sem,pc1,pc2)   
   9.191 +         --> (pc1 = #a ~> pc1 = #b)"
   9.192 +  apply (rule SF1)
   9.193 +  apply (tactic {* action_simp_tac (simpset () addsimps thms "Psi_defs") [] [thm "squareE"] 1 *})
   9.194 +  apply (tactic
   9.195 +    {* action_simp_tac (simpset () addsimps (thm "angle_def" :: thms "Psi_defs")) [] [] 1 *})
   9.196 +  apply (clarsimp intro!: N1_enabled_at_both_a [THEN DmdImpl [temp_use]])
   9.197 +  apply (auto intro!: BoxDmd2_simple [temp_use] N2_live [temp_use]
   9.198 +    simp: split_box_conj more_temp_simps)
   9.199 +  done
   9.200 +
   9.201 +(* Combine the leadsto properties for N1: it will arrive at pc1 = b *)
   9.202 +
   9.203 +lemma N1_leadsto_b: "|- []($PsiInv & [(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2))              
   9.204 +         & SF(N1)_(x,y,sem,pc1,pc2) & [] SF(N2)_(x,y,sem,pc1,pc2)   
   9.205 +         --> (pc1 = #b | pc1 = #g | pc1 = #a ~> pc1 = #b)"
   9.206 +  apply (auto intro!: LatticeDisjunctionIntro [temp_use])
   9.207 +    apply (rule LatticeReflexivity [temp_use])
   9.208 +   apply (rule LatticeTransitivity [temp_use])
   9.209 +    apply (auto intro!: a1_leadsto_b1 [temp_use] g1_leadsto_a1 [temp_use]
   9.210 +      simp: split_box_conj)
   9.211 +  done
   9.212 +
   9.213 +lemma N1_live: "|- []($PsiInv & [(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2))              
   9.214 +         & SF(N1)_(x,y,sem,pc1,pc2) & [] SF(N2)_(x,y,sem,pc1,pc2)   
   9.215 +         --> <>(pc1 = #b)"
   9.216 +  apply (auto simp: Init_defs intro!: N1_leadsto_b [temp_use, THEN [2] leadsto_init [temp_use]])
   9.217 +  apply (case_tac "pc1 (st1 sigma)")
   9.218 +    apply auto
   9.219 +  done
   9.220 +
   9.221 +lemma N1_enabled_at_b: "|- pc1 = #b --> Enabled (<N1>_(x,y,sem,pc1,pc2))"
   9.222 +  apply clarsimp
   9.223 +  apply (rule_tac F = beta1 in enabled_mono)
   9.224 +   apply (tactic {* enabled_tac (thm "Inc_base") 1 *})
   9.225 +   apply (force simp: beta1_def)
   9.226 +  apply (force simp: angle_def beta1_def N1_def)
   9.227 +  done
   9.228 +
   9.229 +(* Now assemble the bits and pieces to prove that Psi is fair. *)
   9.230 +
   9.231 +lemma Fair_M1_lemma: "|- []($PsiInv & [(N1 | N2)]_(x,y,sem,pc1,pc2))    
   9.232 +         & SF(N1)_(x,y,sem,pc1,pc2) & []SF(N2)_(x,y,sem,pc1,pc2)   
   9.233 +         --> SF(M1)_(x,y)"
   9.234 +  apply (rule_tac B = beta1 and P = "PRED pc1 = #b" in SF2)
   9.235 +   (* action premises *)
   9.236 +     apply (force simp: angle_def M1_def beta1_def)
   9.237 +  apply (force simp: angle_def Psi_defs)
   9.238 +  apply (force elim!: N1_enabled_at_b [temp_use])
   9.239 +    (* temporal premise: use previous lemmas and simple TL *)
   9.240 +  apply (force intro!: DmdStable [temp_use] N1_live [temp_use] Stuck_at_b [temp_use]
   9.241 +    elim: STL4E [temp_use] simp: square_def)
   9.242 +  done
   9.243 +
   9.244 +lemma Fair_M1: "|- Psi --> WF(M1)_(x,y)"
   9.245 +  by (auto intro!: SFImplWF [temp_use] Fair_M1_lemma [temp_use] PsiInv [temp_use]
   9.246 +    simp: Psi_def split_box_conj [temp_use] more_temp_simps)
   9.247  
   9.248  end
    10.1 --- a/src/HOL/TLA/Init.ML	Fri Dec 01 17:22:33 2006 +0100
    10.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    10.3 @@ -1,45 +0,0 @@
    10.4 -
    10.5 -(* $Id$ *)
    10.6 -
    10.7 -local
    10.8 -  fun prover s = prove_goal (the_context ()) s
    10.9 -                    (K [force_tac (claset(), simpset() addsimps [Init_def]) 1])
   10.10 -in
   10.11 -  val const_simps = map (int_rewrite o prover)
   10.12 -      [ "|- (Init #True) = #True",
   10.13 -        "|- (Init #False) = #False"]
   10.14 -  val Init_simps = map (int_rewrite o prover)
   10.15 -      [ "|- (Init ~F) = (~ Init F)",
   10.16 -        "|- (Init (P --> Q)) = (Init P --> Init Q)",
   10.17 -        "|- (Init (P & Q)) = (Init P & Init Q)",
   10.18 -        "|- (Init (P | Q)) = (Init P | Init Q)",
   10.19 -        "|- (Init (P = Q)) = ((Init P) = (Init Q))",
   10.20 -        "|- (Init (!x. F x)) = (!x. (Init F x))",
   10.21 -        "|- (Init (? x. F x)) = (? x. (Init F x))",
   10.22 -        "|- (Init (?! x. F x)) = (?! x. (Init F x))"
   10.23 -      ]
   10.24 -end;
   10.25 -
   10.26 -Addsimps const_simps;
   10.27 -
   10.28 -Goal "|- (Init $P) = (Init P)";
   10.29 -by (force_tac (claset(), simpset() addsimps [Init_def,fw_act_def,fw_stp_def]) 1);
   10.30 -qed "Init_stp_act";
   10.31 -val Init_simps = (int_rewrite Init_stp_act)::Init_simps;
   10.32 -bind_thm("Init_stp_act_rev", symmetric(int_rewrite Init_stp_act));
   10.33 -
   10.34 -Goal "|- (Init F) = F";
   10.35 -by (force_tac (claset(), simpset() addsimps [Init_def,fw_temp_def]) 1);
   10.36 -qed "Init_temp";
   10.37 -val Init_simps = (int_rewrite Init_temp)::Init_simps;
   10.38 -
   10.39 -(* Trivial instances of the definitions that avoid introducing lambda expressions. *)
   10.40 -Goalw [Init_def,fw_stp_def] "(sigma |= Init P) = P (st1 sigma)";
   10.41 -by (rtac refl 1);
   10.42 -qed "Init_stp";
   10.43 -
   10.44 -Goalw [Init_def,fw_act_def] "(sigma |= Init A) = A (st1 sigma, st2 sigma)";
   10.45 -by (rtac refl 1);
   10.46 -qed "Init_act";
   10.47 -
   10.48 -val Init_defs = [Init_stp, Init_act, int_use Init_temp];
    11.1 --- a/src/HOL/TLA/Init.thy	Fri Dec 01 17:22:33 2006 +0100
    11.2 +++ b/src/HOL/TLA/Init.thy	Sat Dec 02 02:52:02 2006 +0100
    11.3 @@ -4,9 +4,6 @@
    11.4      Author:      Stephan Merz
    11.5      Copyright:   1998 University of Munich
    11.6  
    11.7 -    Theory Name: Init
    11.8 -    Logic Image: HOL
    11.9 -
   11.10  Introduces type of temporal formulas. Defines interface between
   11.11  temporal formulas and its "subformulas" (state predicates and actions).
   11.12  *)
   11.13 @@ -43,6 +40,40 @@
   11.14    fw_stp_def:  "first_world == st1"
   11.15    fw_act_def:  "first_world == %sigma. (st1 sigma, st2 sigma)"
   11.16  
   11.17 -ML {* use_legacy_bindings (the_context ()) *}
   11.18 +lemma const_simps [int_rewrite, simp]:
   11.19 +  "|- (Init #True) = #True"
   11.20 +  "|- (Init #False) = #False"
   11.21 +  by (auto simp: Init_def)
   11.22 +
   11.23 +lemma Init_simps [int_rewrite]:
   11.24 +  "!!F. |- (Init ~F) = (~ Init F)"
   11.25 +  "|- (Init (P --> Q)) = (Init P --> Init Q)"
   11.26 +  "|- (Init (P & Q)) = (Init P & Init Q)"
   11.27 +  "|- (Init (P | Q)) = (Init P | Init Q)"
   11.28 +  "|- (Init (P = Q)) = ((Init P) = (Init Q))"
   11.29 +  "|- (Init (!x. F x)) = (!x. (Init F x))"
   11.30 +  "|- (Init (? x. F x)) = (? x. (Init F x))"
   11.31 +  "|- (Init (?! x. F x)) = (?! x. (Init F x))"
   11.32 +  by (auto simp: Init_def)
   11.33 +
   11.34 +lemma Init_stp_act: "|- (Init $P) = (Init P)"
   11.35 +  by (auto simp add: Init_def fw_act_def fw_stp_def)
   11.36 +
   11.37 +lemmas Init_simps = Init_stp_act [int_rewrite] Init_simps
   11.38 +lemmas Init_stp_act_rev = Init_stp_act [int_rewrite, symmetric]
   11.39 +
   11.40 +lemma Init_temp: "|- (Init F) = F"
   11.41 +  by (auto simp add: Init_def fw_temp_def)
   11.42 +
   11.43 +lemmas Init_simps = Init_temp [int_rewrite] Init_simps
   11.44 +
   11.45 +(* Trivial instances of the definitions that avoid introducing lambda expressions. *)
   11.46 +lemma Init_stp: "(sigma |= Init P) = P (st1 sigma)"
   11.47 +  by (simp add: Init_def fw_stp_def)
   11.48 +
   11.49 +lemma Init_act: "(sigma |= Init A) = A (st1 sigma, st2 sigma)"
   11.50 +  by (simp add: Init_def fw_act_def)
   11.51 +
   11.52 +lemmas Init_defs = Init_stp Init_act Init_temp [int_use]
   11.53  
   11.54  end
    12.1 --- a/src/HOL/TLA/Intensional.ML	Fri Dec 01 17:22:33 2006 +0100
    12.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    12.3 @@ -1,125 +0,0 @@
    12.4 -(*
    12.5 -    File:        Intensional.ML
    12.6 -    ID:          $Id$
    12.7 -    Author:      Stephan Merz
    12.8 -    Copyright:   1998 University of Munich
    12.9 -
   12.10 -Lemmas and tactics for "intensional" logics.
   12.11 -*)
   12.12 -
   12.13 -val intensional_rews = [unl_con,unl_lift,unl_lift2,unl_lift3,unl_Rall,unl_Rex,unl_Rex1];
   12.14 -
   12.15 -Goalw [Valid_def,unl_lift2] "|- x=y  ==>  (x==y)";
   12.16 -by (rtac eq_reflection 1);
   12.17 -by (rtac ext 1);
   12.18 -by (etac spec 1);
   12.19 -qed "inteq_reflection";
   12.20 -
   12.21 -val [prem] = goalw (the_context ()) [Valid_def] "(!!w. w |= A) ==> |- A";
   12.22 -by (REPEAT (resolve_tac [allI,prem] 1));
   12.23 -qed "intI";
   12.24 -
   12.25 -Goalw [Valid_def] "|- A ==> w |= A";
   12.26 -by (etac spec 1);
   12.27 -qed "intD";
   12.28 -
   12.29 -(** Lift usual HOL simplifications to "intensional" level. **)
   12.30 -local
   12.31 -
   12.32 -fun prover s = (prove_goal (the_context ()) s
   12.33 -                 (fn _ => [rewrite_goals_tac (Valid_def::intensional_rews),
   12.34 -                           blast_tac HOL_cs 1])) RS inteq_reflection
   12.35 -
   12.36 -in
   12.37 -
   12.38 -val int_simps = map prover
   12.39 - [ "|- (x=x) = #True",
   12.40 -   "|- (~#True) = #False", "|- (~#False) = #True", "|- (~~ P) = P",
   12.41 -   "|- ((~P) = P) = #False", "|- (P = (~P)) = #False",
   12.42 -   "|- (P ~= Q) = (P = (~Q))",
   12.43 -   "|- (#True=P) = P", "|- (P=#True) = P",
   12.44 -   "|- (#True --> P) = P", "|- (#False --> P) = #True",
   12.45 -   "|- (P --> #True) = #True", "|- (P --> P) = #True",
   12.46 -   "|- (P --> #False) = (~P)", "|- (P --> ~P) = (~P)",
   12.47 -   "|- (P & #True) = P", "|- (#True & P) = P",
   12.48 -   "|- (P & #False) = #False", "|- (#False & P) = #False",
   12.49 -   "|- (P & P) = P", "|- (P & ~P) = #False", "|- (~P & P) = #False",
   12.50 -   "|- (P | #True) = #True", "|- (#True | P) = #True",
   12.51 -   "|- (P | #False) = P", "|- (#False | P) = P",
   12.52 -   "|- (P | P) = P", "|- (P | ~P) = #True", "|- (~P | P) = #True",
   12.53 -   "|- (! x. P) = P", "|- (? x. P) = P",
   12.54 -   "|- (~Q --> ~P) = (P --> Q)",
   12.55 -   "|- (P|Q --> R) = ((P-->R)&(Q-->R))" ]
   12.56 -end;
   12.57 -
   12.58 -Goal "|- #True";
   12.59 -by (simp_tac (simpset() addsimps [Valid_def,unl_con]) 1);
   12.60 -qed "TrueW";
   12.61 -
   12.62 -Addsimps (TrueW::intensional_rews);
   12.63 -Addsimps int_simps;
   12.64 -AddSIs [intI];
   12.65 -AddDs  [intD];
   12.66 -
   12.67 -
   12.68 -(* ======== Functions to "unlift" intensional implications into HOL rules ====== *)
   12.69 -
   12.70 -(* Basic unlifting introduces a parameter "w" and applies basic rewrites, e.g.
   12.71 -   |- F = G    becomes   F w = G w
   12.72 -   |- F --> G  becomes   F w --> G w
   12.73 -*)
   12.74 -
   12.75 -fun int_unlift th =
   12.76 -  rewrite_rule intensional_rews ((th RS intD) handle _ => th);
   12.77 -
   12.78 -(* Turn  |- F = G  into meta-level rewrite rule  F == G *)
   12.79 -fun int_rewrite th =
   12.80 -    zero_var_indexes (rewrite_rule intensional_rews (th RS inteq_reflection));
   12.81 -
   12.82 -(* flattening turns "-->" into "==>" and eliminates conjunctions in the
   12.83 -   antecedent. For example,
   12.84 -
   12.85 -         P & Q --> (R | S --> T)    becomes   [| P; Q; R | S |] ==> T
   12.86 -
   12.87 -   Flattening can be useful with "intensional" lemmas (after unlifting).
   12.88 -   Naive resolution with mp and conjI may run away because of higher-order
   12.89 -   unification, therefore the code is a little awkward.
   12.90 -*)
   12.91 -fun flatten t =
   12.92 -  let
   12.93 -    (* analogous to RS, but using matching instead of resolution *)
   12.94 -    fun matchres tha i thb =
   12.95 -      case Seq.chop 2 (biresolution true [(false,tha)] i thb) of
   12.96 -          ([th],_) => th
   12.97 -        | ([],_)   => raise THM("matchres: no match", i, [tha,thb])
   12.98 -        |      _   => raise THM("matchres: multiple unifiers", i, [tha,thb])
   12.99 -
  12.100 -    (* match tha with some premise of thb *)
  12.101 -    fun matchsome tha thb =
  12.102 -      let fun hmatch 0 = raise THM("matchsome: no match", 0, [tha,thb])
  12.103 -            | hmatch n = (matchres tha n thb) handle _ => hmatch (n-1)
  12.104 -      in hmatch (nprems_of thb) end
  12.105 -
  12.106 -    fun hflatten t =
  12.107 -        case (concl_of t) of
  12.108 -          Const _ $ (Const ("op -->", _) $ _ $ _) => hflatten (t RS mp)
  12.109 -        | _ => (hflatten (matchsome conjI t)) handle _ => zero_var_indexes t
  12.110 -  in
  12.111 -    hflatten t
  12.112 -end;
  12.113 -
  12.114 -fun int_use th =
  12.115 -    case (concl_of th) of
  12.116 -      Const _ $ (Const ("Intensional.Valid", _) $ _) =>
  12.117 -              ((flatten (int_unlift th)) handle _ => th)
  12.118 -    | _ => th;
  12.119 -
  12.120 -(* ========================================================================= *)
  12.121 -
  12.122 -Goalw [Valid_def] "|- (~(! x. F x)) = (? x. ~F x)";
  12.123 -by (Simp_tac 1);
  12.124 -qed "Not_Rall";
  12.125 -
  12.126 -Goalw [Valid_def] "|- (~ (? x. F x)) = (! x. ~ F x)";
  12.127 -by (Simp_tac 1);
  12.128 -qed "Not_Rex";
    13.1 --- a/src/HOL/TLA/Intensional.thy	Fri Dec 01 17:22:33 2006 +0100
    13.2 +++ b/src/HOL/TLA/Intensional.thy	Sat Dec 02 02:52:02 2006 +0100
    13.3 @@ -3,13 +3,10 @@
    13.4      ID:          $Id$
    13.5      Author:      Stephan Merz
    13.6      Copyright:   1998 University of Munich
    13.7 -
    13.8 -    Theory Name: Intensional
    13.9 -    Logic Image: HOL
   13.10 +*)
   13.11  
   13.12 -Define a framework for "intensional" (possible-world based) logics
   13.13 -on top of HOL, with lifting of constants and functions.
   13.14 -*)
   13.15 +header {* A framework for "intensional" (possible-world based) logics
   13.16 +  on top of HOL, with lifting of constants and functions *}
   13.17  
   13.18  theory Intensional
   13.19  imports Main
   13.20 @@ -188,6 +185,136 @@
   13.21    unl_Rex:     "w |= EX x. A x   ==  EX x. (w |= A x)"
   13.22    unl_Rex1:    "w |= EX! x. A x  ==  EX! x. (w |= A x)"
   13.23  
   13.24 -ML {* use_legacy_bindings (the_context ()) *}
   13.25 +
   13.26 +subsection {* Lemmas and tactics for "intensional" logics. *}
   13.27 +
   13.28 +lemmas intensional_rews [simp] =
   13.29 +  unl_con unl_lift unl_lift2 unl_lift3 unl_Rall unl_Rex unl_Rex1
   13.30 +
   13.31 +lemma inteq_reflection: "|- x=y  ==>  (x==y)"
   13.32 +  apply (unfold Valid_def unl_lift2)
   13.33 +  apply (rule eq_reflection)
   13.34 +  apply (rule ext)
   13.35 +  apply (erule spec)
   13.36 +  done
   13.37 +
   13.38 +lemma intI [intro!]: "(!!w. w |= A) ==> |- A"
   13.39 +  apply (unfold Valid_def)
   13.40 +  apply (rule allI)
   13.41 +  apply (erule meta_spec)
   13.42 +  done
   13.43 +
   13.44 +lemma intD [dest]: "|- A ==> w |= A"
   13.45 +  apply (unfold Valid_def)
   13.46 +  apply (erule spec)
   13.47 +  done
   13.48 +
   13.49 +(** Lift usual HOL simplifications to "intensional" level. **)
   13.50 +
   13.51 +lemma int_simps:
   13.52 +  "|- (x=x) = #True"
   13.53 +  "|- (~#True) = #False"  "|- (~#False) = #True"  "|- (~~ P) = P"
   13.54 +  "|- ((~P) = P) = #False"  "|- (P = (~P)) = #False"
   13.55 +  "|- (P ~= Q) = (P = (~Q))"
   13.56 +  "|- (#True=P) = P"  "|- (P=#True) = P"
   13.57 +  "|- (#True --> P) = P"  "|- (#False --> P) = #True"
   13.58 +  "|- (P --> #True) = #True"  "|- (P --> P) = #True"
   13.59 +  "|- (P --> #False) = (~P)"  "|- (P --> ~P) = (~P)"
   13.60 +  "|- (P & #True) = P"  "|- (#True & P) = P"
   13.61 +  "|- (P & #False) = #False"  "|- (#False & P) = #False"
   13.62 +  "|- (P & P) = P"  "|- (P & ~P) = #False"  "|- (~P & P) = #False"
   13.63 +  "|- (P | #True) = #True"  "|- (#True | P) = #True"
   13.64 +  "|- (P | #False) = P"  "|- (#False | P) = P"
   13.65 +  "|- (P | P) = P"  "|- (P | ~P) = #True"  "|- (~P | P) = #True"
   13.66 +  "|- (! x. P) = P"  "|- (? x. P) = P"
   13.67 +  "|- (~Q --> ~P) = (P --> Q)"
   13.68 +  "|- (P|Q --> R) = ((P-->R)&(Q-->R))"
   13.69 +  apply (unfold Valid_def intensional_rews)
   13.70 +  apply blast+
   13.71 +  done
   13.72 +
   13.73 +declare int_simps [THEN inteq_reflection, simp]
   13.74 +
   13.75 +lemma TrueW [simp]: "|- #True"
   13.76 +  by (simp add: Valid_def unl_con)
   13.77 +
   13.78 +
   13.79 +
   13.80 +(* ======== Functions to "unlift" intensional implications into HOL rules ====== *)
   13.81 +
   13.82 +ML {*
   13.83 +
   13.84 +local
   13.85 +  val intD = thm "intD";
   13.86 +  val inteq_reflection = thm "inteq_reflection";
   13.87 +  val intensional_rews = thms "intensional_rews";
   13.88 +in
   13.89 +
   13.90 +(* Basic unlifting introduces a parameter "w" and applies basic rewrites, e.g.
   13.91 +   |- F = G    becomes   F w = G w
   13.92 +   |- F --> G  becomes   F w --> G w
   13.93 +*)
   13.94 +
   13.95 +fun int_unlift th =
   13.96 +  rewrite_rule intensional_rews (th RS intD handle THM _ => th);
   13.97 +
   13.98 +(* Turn  |- F = G  into meta-level rewrite rule  F == G *)
   13.99 +fun int_rewrite th =
  13.100 +  zero_var_indexes (rewrite_rule intensional_rews (th RS inteq_reflection))
  13.101 +
  13.102 +(* flattening turns "-->" into "==>" and eliminates conjunctions in the
  13.103 +   antecedent. For example,
  13.104 +
  13.105 +         P & Q --> (R | S --> T)    becomes   [| P; Q; R | S |] ==> T
  13.106 +
  13.107 +   Flattening can be useful with "intensional" lemmas (after unlifting).
  13.108 +   Naive resolution with mp and conjI may run away because of higher-order
  13.109 +   unification, therefore the code is a little awkward.
  13.110 +*)
  13.111 +fun flatten t =
  13.112 +  let
  13.113 +    (* analogous to RS, but using matching instead of resolution *)
  13.114 +    fun matchres tha i thb =
  13.115 +      case Seq.chop 2 (biresolution true [(false,tha)] i thb) of
  13.116 +          ([th],_) => th
  13.117 +        | ([],_)   => raise THM("matchres: no match", i, [tha,thb])
  13.118 +        |      _   => raise THM("matchres: multiple unifiers", i, [tha,thb])
  13.119 +
  13.120 +    (* match tha with some premise of thb *)
  13.121 +    fun matchsome tha thb =
  13.122 +      let fun hmatch 0 = raise THM("matchsome: no match", 0, [tha,thb])
  13.123 +            | hmatch n = matchres tha n thb handle THM _ => hmatch (n-1)
  13.124 +      in hmatch (nprems_of thb) end
  13.125 +
  13.126 +    fun hflatten t =
  13.127 +        case (concl_of t) of
  13.128 +          Const _ $ (Const ("op -->", _) $ _ $ _) => hflatten (t RS mp)
  13.129 +        | _ => (hflatten (matchsome conjI t)) handle THM _ => zero_var_indexes t
  13.130 +  in
  13.131 +    hflatten t
  13.132 +  end
  13.133 +
  13.134 +fun int_use th =
  13.135 +    case (concl_of th) of
  13.136 +      Const _ $ (Const ("Intensional.Valid", _) $ _) =>
  13.137 +              (flatten (int_unlift th) handle THM _ => th)
  13.138 +    | _ => th
  13.139  
  13.140  end
  13.141 +*}
  13.142 +
  13.143 +setup {*
  13.144 +  Attrib.add_attributes [
  13.145 +    ("int_unlift", Attrib.no_args (Thm.rule_attribute (K int_unlift)), ""),
  13.146 +    ("int_rewrite", Attrib.no_args (Thm.rule_attribute (K int_rewrite)), ""),
  13.147 +    ("flatten", Attrib.no_args (Thm.rule_attribute (K flatten)), ""),
  13.148 +    ("int_use", Attrib.no_args (Thm.rule_attribute (K int_use)), "")]
  13.149 +*}
  13.150 +
  13.151 +lemma Not_Rall: "|- (~(! x. F x)) = (? x. ~F x)"
  13.152 +  by (simp add: Valid_def)
  13.153 +
  13.154 +lemma Not_Rex: "|- (~ (? x. F x)) = (! x. ~ F x)"
  13.155 +  by (simp add: Valid_def)
  13.156 +
  13.157 +end
    14.1 --- a/src/HOL/TLA/Memory/MIsafe.ML	Fri Dec 01 17:22:33 2006 +0100
    14.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    14.3 @@ -1,341 +0,0 @@
    14.4 -(* 
    14.5 -    File:        MIsafe.ML
    14.6 -    ID:          $Id$
    14.7 -    Author:      Stephan Merz
    14.8 -    Copyright:   1997 University of Munich
    14.9 -
   14.10 -    RPC-Memory example: Lower-level lemmas about memory implementation (safety)
   14.11 -*)
   14.12 -
   14.13 -(* ========================= Lemmas about values ========================= *)
   14.14 -
   14.15 -(* RPCFailure notin MemVals U {OK,BadArg} *)
   14.16 -
   14.17 -Goalw [MVOKBA_def] "MVOKBA x ==> x ~= RPCFailure";
   14.18 -by Auto_tac;
   14.19 -qed "MVOKBAnotRF";
   14.20 -
   14.21 -(* NotAResult notin MemVals U {OK,BadArg,RPCFailure} *)
   14.22 -
   14.23 -Goalw [MVOKBARF_def] "MVOKBARF x ==> x ~= NotAResult";
   14.24 -by Auto_tac;
   14.25 -qed "MVOKBARFnotNR";
   14.26 -
   14.27 -(* ================ Si's are mutually exclusive ================================ *)
   14.28 -(* Si and Sj are mutually exclusive for i # j. This helps to simplify the big
   14.29 -   conditional in the definition of resbar when doing the step-simulation proof.
   14.30 -   We prove a weaker result, which suffices for our purposes: 
   14.31 -   Si implies (not Sj), for j<i.
   14.32 -*)
   14.33 -
   14.34 -(* --- not used ---
   14.35 -Goal "|- S1 rmhist p --> S1 rmhist p & ~S2 rmhist p & ~S3 rmhist p & \
   14.36 -\                        ~S4 rmhist p & ~S5 rmhist p & ~S6 rmhist p";
   14.37 -by (auto_tac (MI_css addsimps2 [S_def, S1_def, S2_def,
   14.38 -                                S3_def, S4_def, S5_def, S6_def]));
   14.39 -qed "S1_excl";
   14.40 -*)
   14.41 -
   14.42 -Goal "|- S2 rmhist p --> S2 rmhist p & ~S1 rmhist p";
   14.43 -by (auto_tac (MI_css addsimps2 [S_def, S1_def, S2_def]));
   14.44 -qed "S2_excl";
   14.45 -
   14.46 -Goal "|- S3 rmhist p --> S3 rmhist p & ~S1 rmhist p & ~S2 rmhist p";
   14.47 -by (auto_tac (MI_css addsimps2 [S_def, S1_def, S2_def, S3_def]));
   14.48 -qed "S3_excl";
   14.49 -
   14.50 -Goal "|- S4 rmhist p --> S4 rmhist p & ~S1 rmhist p & ~S2 rmhist p & ~S3 rmhist p";
   14.51 -by (auto_tac (MI_css addsimps2 [S_def,S1_def,S2_def,S3_def,S4_def]));
   14.52 -qed "S4_excl";
   14.53 -
   14.54 -Goal "|- S5 rmhist p --> S5 rmhist p & ~S1 rmhist p & ~S2 rmhist p \
   14.55 -\                        & ~S3 rmhist p & ~S4 rmhist p";
   14.56 -by (auto_tac (MI_css addsimps2 [S_def,S1_def,S2_def,S3_def,S4_def,S5_def]));
   14.57 -qed "S5_excl";
   14.58 -
   14.59 -Goal "|- S6 rmhist p --> S6 rmhist p & ~S1 rmhist p & ~S2 rmhist p  \
   14.60 -\                        & ~S3 rmhist p & ~S4 rmhist p & ~S5 rmhist p";
   14.61 -by (auto_tac (MI_css addsimps2 [S_def,S1_def,S2_def,S3_def,S4_def,S5_def,S6_def]));
   14.62 -qed "S6_excl";
   14.63 -
   14.64 -
   14.65 -(* ==================== Lemmas about the environment ============================== *)
   14.66 -
   14.67 -Goal "|- $(Calling memCh p) --> ~ENext p";
   14.68 -by (auto_tac (MI_css addsimps2 [ENext_def,Call_def]));
   14.69 -qed "Envbusy";
   14.70 -
   14.71 -(* ==================== Lemmas about the implementation's states ==================== *)
   14.72 -
   14.73 -(* The following series of lemmas are used in establishing the implementation's
   14.74 -   next-state relation (Step 1.2 of the proof in the paper). For each state Si, we
   14.75 -   determine which component actions are possible and what state they result in.
   14.76 -*)
   14.77 -
   14.78 -(* ------------------------------ State S1 ---------------------------------------- *) 
   14.79 -
   14.80 -Goal "|- ENext p & $(S1 rmhist p) & unchanged (c p, r p, m p, rmhist!p) \
   14.81 -\        --> (S2 rmhist p)$";
   14.82 -by (force_tac (MI_css addsimps2 [ENext_def,Call_def,c_def,r_def,m_def,
   14.83 -                                 caller_def,rtrner_def,MVNROKBA_def,
   14.84 -                                 S_def,S1_def,S2_def,Calling_def]) 1);
   14.85 -qed "S1Env";
   14.86 -
   14.87 -Goal "|- [MClkNext memCh crCh cst p]_(c p) & $(S1 rmhist p) --> unchanged (c p)";
   14.88 -by (auto_tac (MI_fast_css addSDs2 [MClkidle] addsimps2 [S_def,S1_def]));
   14.89 -qed "S1ClerkUnch";
   14.90 -
   14.91 -Goal "|- [RPCNext crCh rmCh rst p]_(r p) & $(S1 rmhist p) --> unchanged (r p)";
   14.92 -by (auto_tac (MI_fast_css addSDs2 [RPCidle] addsimps2 [S_def,S1_def]));
   14.93 -qed "S1RPCUnch";
   14.94 -
   14.95 -Goal "|- [RNext rmCh mm ires p]_(m p) & $(S1 rmhist p) --> unchanged (m p)";
   14.96 -by (auto_tac (MI_fast_css addSDs2 [Memoryidle] addsimps2 [S_def,S1_def]));
   14.97 -qed "S1MemUnch";
   14.98 -
   14.99 -Goal "|- [HNext rmhist p]_(c p,r p,m p,rmhist!p) & $(S1 rmhist p)\
  14.100 -\        --> unchanged (rmhist!p)";
  14.101 -by (action_simp_tac (simpset() addsimps [HNext_def, S_def, S1_def, MemReturn_def, 
  14.102 -                                         RPCFail_def,MClkReply_def,Return_def])
  14.103 -                    [] [squareE] 1);
  14.104 -qed "S1Hist";
  14.105 -
  14.106 -(* ------------------------------ State S2 ---------------------------------------- *)
  14.107 -
  14.108 -Goal "|- [ENext p]_(e p) & $(S2 rmhist p) --> unchanged (e p)";
  14.109 -by (auto_tac (MI_css addSDs2 [Envbusy] addsimps2 [S_def,S2_def]));
  14.110 -qed "S2EnvUnch";
  14.111 -
  14.112 -Goal "|- MClkNext memCh crCh cst p & $(S2 rmhist p) --> MClkFwd memCh crCh cst p";
  14.113 -by (auto_tac (MI_css addsimps2 [MClkNext_def,MClkRetry_def,MClkReply_def,
  14.114 -                                S_def,S2_def]));
  14.115 -qed "S2Clerk";
  14.116 -
  14.117 -Goal "|- $(S2 rmhist p) & MClkFwd memCh crCh cst p\
  14.118 -\        & unchanged (e p, r p, m p, rmhist!p) \
  14.119 -\        --> (S3 rmhist p)$";
  14.120 -by (action_simp_tac 
  14.121 -         (simpset() addsimps
  14.122 -                [MClkFwd_def,Call_def,e_def,r_def,m_def,caller_def,rtrner_def,
  14.123 -                 S_def,S2_def,S3_def,Calling_def])
  14.124 -         [] [] 1);
  14.125 -qed "S2Forward";
  14.126 -
  14.127 -Goal "|- [RPCNext crCh rmCh rst p]_(r p) & $(S2 rmhist p) --> unchanged (r p)";
  14.128 -by (auto_tac (MI_css addsimps2 [S_def,S2_def] addSDs2 [RPCidle]));
  14.129 -qed "S2RPCUnch";
  14.130 -
  14.131 -Goal "|- [RNext rmCh mm ires p]_(m p) & $(S2 rmhist p) --> unchanged (m p)";
  14.132 -by (auto_tac (MI_css addsimps2 [S_def,S2_def] addSDs2 [Memoryidle]));
  14.133 -qed "S2MemUnch";
  14.134 -
  14.135 -Goal "|- [HNext rmhist p]_(c p,r p,m p,rmhist!p) & $(S2 rmhist p)\
  14.136 -\        --> unchanged (rmhist!p)";
  14.137 -by (auto_tac (MI_fast_css
  14.138 -		addsimps2 [HNext_def,MemReturn_def,
  14.139 -		           RPCFail_def,MClkReply_def,Return_def,S_def,S2_def]));
  14.140 -qed "S2Hist";
  14.141 -
  14.142 -(* ------------------------------ State S3 ---------------------------------------- *)
  14.143 -
  14.144 -Goal "|- [ENext p]_(e p) & $(S3 rmhist p) --> unchanged (e p)";
  14.145 -by (auto_tac (MI_css addSDs2 [Envbusy] addsimps2 [S_def,S3_def]));
  14.146 -qed "S3EnvUnch";
  14.147 -
  14.148 -Goal "|- [MClkNext memCh crCh cst p]_(c p) & $(S3 rmhist p) --> unchanged (c p)";
  14.149 -by (auto_tac (MI_css addSDs2 [MClkbusy] addsimps2 [square_def,S_def,S3_def]));
  14.150 -qed "S3ClerkUnch";
  14.151 -
  14.152 -Goal "|- S3 rmhist p --> IsLegalRcvArg<arg<crCh!p>>";
  14.153 -by (auto_tac (MI_css addsimps2 [IsLegalRcvArg_def,MClkRelayArg_def,S_def,S3_def]));
  14.154 -qed "S3LegalRcvArg";
  14.155 -
  14.156 -Goal "|- RPCNext crCh rmCh rst p & $(S3 rmhist p) \
  14.157 -\        --> RPCFwd crCh rmCh rst p | RPCFail crCh rmCh rst p";
  14.158 -by (Clarsimp_tac 1);
  14.159 -by (forward_tac [action_use S3LegalRcvArg] 1);
  14.160 -by (auto_tac (MI_css addsimps2 [RPCNext_def,RPCReject_def,RPCReply_def,S_def,S3_def]));
  14.161 -qed "S3RPC";
  14.162 -
  14.163 -Goal "|- RPCFwd crCh rmCh rst p & HNext rmhist p & $(S3 rmhist p)\
  14.164 -\        & unchanged (e p, c p, m p) \
  14.165 -\        --> (S4 rmhist p)$ & unchanged (rmhist!p)";
  14.166 -by (action_simp_tac 
  14.167 -      (simpset() addsimps [RPCFwd_def,HNext_def,MemReturn_def,RPCFail_def,MClkReply_def,
  14.168 -	                   Return_def,Call_def,e_def,c_def,m_def,caller_def,rtrner_def, 
  14.169 -                           S_def,S3_def,S4_def,Calling_def])
  14.170 -      [] [] 1);
  14.171 -qed "S3Forward";
  14.172 -
  14.173 -Goal "|- RPCFail crCh rmCh rst p & $(S3 rmhist p) & HNext rmhist p\
  14.174 -\        & unchanged (e p, c p, m p) \
  14.175 -\        --> (S6 rmhist p)$";
  14.176 -by (action_simp_tac 
  14.177 -      (simpset() addsimps [HNext_def,RPCFail_def,Return_def,e_def,c_def,m_def,
  14.178 -			   caller_def,rtrner_def,MVOKBARF_def,
  14.179 -			   S_def,S3_def,S6_def,Calling_def])
  14.180 -      [] [] 1);
  14.181 -qed "S3Fail";
  14.182 -
  14.183 -Goal "|- [RNext rmCh mm ires p]_(m p) & $(S3 rmhist p) --> unchanged (m p)";
  14.184 -by (auto_tac (MI_css addsimps2 [S_def,S3_def] addSDs2 [Memoryidle]));
  14.185 -qed "S3MemUnch";
  14.186 -
  14.187 -Goal "|- HNext rmhist p & $(S3 rmhist p) & unchanged (r p) --> unchanged (rmhist!p)";
  14.188 -by (auto_tac (MI_css addsimps2 [HNext_def,MemReturn_def,RPCFail_def,MClkReply_def,
  14.189 -			        Return_def,r_def,rtrner_def,S_def,S3_def,Calling_def]));
  14.190 -qed "S3Hist";
  14.191 -
  14.192 -(* ------------------------------ State S4 ---------------------------------------- *)
  14.193 -
  14.194 -Goal "|- [ENext p]_(e p) & $(S4 rmhist p) --> unchanged (e p)";
  14.195 -by (auto_tac (MI_css addsimps2 [S_def,S4_def] addSDs2 [Envbusy]));
  14.196 -qed "S4EnvUnch";
  14.197 -
  14.198 -Goal "|- [MClkNext memCh crCh cst p]_(c p) & $(S4 rmhist p) --> unchanged (c p)";
  14.199 -by (auto_tac (MI_css addsimps2 [S_def,S4_def] addSDs2 [MClkbusy]));
  14.200 -qed "S4ClerkUnch";
  14.201 -
  14.202 -Goal "|- [RPCNext crCh rmCh rst p]_(r p) & $(S4 rmhist p) --> unchanged (r p)";
  14.203 -by (auto_tac (MI_fast_css addsimps2 [S_def,S4_def] addSDs2 [RPCbusy]));
  14.204 -qed "S4RPCUnch";
  14.205 -
  14.206 -Goal "|- ReadInner rmCh mm ires p l & $(S4 rmhist p) & unchanged (e p, c p, r p) \
  14.207 -\        & HNext rmhist p & $(MemInv mm l) \
  14.208 -\        --> (S4 rmhist p)$ & unchanged (rmhist!p)";
  14.209 -by (action_simp_tac 
  14.210 -      (simpset() addsimps [ReadInner_def,GoodRead_def, BadRead_def,HNext_def,
  14.211 -			   MemReturn_def, RPCFail_def,MClkReply_def,Return_def,
  14.212 -			   e_def,c_def,r_def,rtrner_def,caller_def,MVNROKBA_def,
  14.213 -			   S_def,S4_def,RdRequest_def,Calling_def,MemInv_def])
  14.214 -      [] [] 1);
  14.215 -qed "S4ReadInner";
  14.216 -
  14.217 -Goal "|- Read rmCh mm ires p & $(S4 rmhist p) & unchanged (e p, c p, r p) \
  14.218 -\        & HNext rmhist p & (!l. $MemInv mm l) \
  14.219 -\        --> (S4 rmhist p)$ & unchanged (rmhist!p)";
  14.220 -by (auto_tac (MI_css addsimps2 [Read_def] addSDs2 [S4ReadInner]));
  14.221 -qed "S4Read";
  14.222 -
  14.223 -Goal "|- WriteInner rmCh mm ires p l v & $(S4 rmhist p) & unchanged (e p, c p, r p) \
  14.224 -\        & HNext rmhist p \
  14.225 -\        --> (S4 rmhist p)$ & unchanged (rmhist!p)";
  14.226 -by (action_simp_tac 
  14.227 -      (simpset() addsimps [WriteInner_def,GoodWrite_def, BadWrite_def,HNext_def,
  14.228 -			   MemReturn_def,RPCFail_def,MClkReply_def,Return_def,
  14.229 -			   e_def,c_def,r_def,rtrner_def,caller_def,MVNROKBA_def, 
  14.230 -			   S_def,S4_def,WrRequest_def,Calling_def])
  14.231 -      [] [] 1);
  14.232 -qed "S4WriteInner";
  14.233 -
  14.234 -Goal "|- Write rmCh mm ires p l & $(S4 rmhist p) & unchanged (e p, c p, r p)\
  14.235 -\        & (HNext rmhist p) \
  14.236 -\        --> (S4 rmhist p)$ & unchanged (rmhist!p)";
  14.237 -by (auto_tac (MI_css addsimps2 [Write_def] addSDs2 [S4WriteInner]));
  14.238 -qed "S4Write";
  14.239 -
  14.240 -Goal "|- $ImpInv rmhist p & Write rmCh mm ires p l --> $S4 rmhist p";
  14.241 -by (auto_tac (MI_css addsimps2 [Write_def,WriteInner_def,ImpInv_def,WrRequest_def,
  14.242 -			        S_def,S1_def,S2_def,S3_def,S4_def,S5_def,S6_def]));
  14.243 -qed "WriteS4";
  14.244 -
  14.245 -Goal "|- MemReturn rmCh ires p & $S4 rmhist p & unchanged (e p, c p, r p)\
  14.246 -\        & HNext rmhist p \
  14.247 -\        --> (S5 rmhist p)$";
  14.248 -by (auto_tac (MI_css addsimps2 [HNext_def,MemReturn_def,Return_def,e_def,c_def,r_def,
  14.249 -				rtrner_def,caller_def,MVNROKBA_def,MVOKBA_def,
  14.250 -		                S_def,S4_def,S5_def,Calling_def]));
  14.251 -qed "S4Return";
  14.252 -
  14.253 -Goal "|- HNext rmhist p & $S4 rmhist p & (m p)$ = $(m p) --> (rmhist!p)$ = $(rmhist!p)";
  14.254 -by (auto_tac (MI_css addsimps2 [HNext_def,MemReturn_def,RPCFail_def,MClkReply_def,
  14.255 -				Return_def,m_def,rtrner_def,S_def,S4_def,Calling_def]));
  14.256 -qed "S4Hist";
  14.257 -
  14.258 -(* ------------------------------ State S5 ---------------------------------------- *)
  14.259 -
  14.260 -Goal "|- [ENext p]_(e p) & $(S5 rmhist p) --> unchanged (e p)";
  14.261 -by (auto_tac (MI_css addsimps2 [S_def,S5_def] addSDs2 [Envbusy]));
  14.262 -qed "S5EnvUnch";
  14.263 -
  14.264 -Goal "|- [MClkNext memCh crCh cst p]_(c p) & $(S5 rmhist p) --> unchanged (c p)";
  14.265 -by (auto_tac (MI_css addsimps2 [S_def,S5_def] addSDs2 [MClkbusy]));
  14.266 -qed "S5ClerkUnch";
  14.267 -
  14.268 -Goal "|- RPCNext crCh rmCh rst p & $(S5 rmhist p)   \
  14.269 -\        --> RPCReply crCh rmCh rst p | RPCFail crCh rmCh rst p";
  14.270 -by (auto_tac (MI_css addsimps2 [RPCNext_def,RPCReject_def,RPCFwd_def,S_def,S5_def]));
  14.271 -qed "S5RPC";
  14.272 -
  14.273 -Goal "|- RPCReply crCh rmCh rst p & $(S5 rmhist p) & unchanged (e p, c p, m p,rmhist!p)\
  14.274 -\      --> (S6 rmhist p)$";
  14.275 -by (action_simp_tac 
  14.276 -      (simpset() addsimps [RPCReply_def,Return_def,e_def,c_def,m_def,
  14.277 -			   MVOKBA_def,MVOKBARF_def,caller_def,rtrner_def,
  14.278 -			   S_def,S5_def,S6_def,Calling_def])
  14.279 -      [] [] 1);
  14.280 -qed "S5Reply";
  14.281 -
  14.282 -Goal "|- RPCFail crCh rmCh rst p & $(S5 rmhist p) & unchanged (e p, c p, m p,rmhist!p) \
  14.283 -\        --> (S6 rmhist p)$";
  14.284 -by (action_simp_tac
  14.285 -      (simpset() addsimps [RPCFail_def,Return_def,e_def,c_def,m_def,
  14.286 -			   MVOKBARF_def,caller_def,rtrner_def,
  14.287 -			   S_def,S5_def,S6_def,Calling_def])
  14.288 -      [] [] 1);
  14.289 -qed "S5Fail";
  14.290 -
  14.291 -Goal "|- [RNext rmCh mm ires p]_(m p) & $(S5 rmhist p) --> unchanged (m p)";
  14.292 -by (auto_tac (MI_css addsimps2 [S_def,S5_def] addSDs2 [Memoryidle]));
  14.293 -qed "S5MemUnch";
  14.294 -
  14.295 -Goal "|- [HNext rmhist p]_(c p, r p, m p, rmhist!p) & $(S5 rmhist p)\
  14.296 -\        --> (rmhist!p)$ = $(rmhist!p)";
  14.297 -by (auto_tac (MI_fast_css
  14.298 -	      addsimps2 [HNext_def,MemReturn_def,
  14.299 -		         RPCFail_def,MClkReply_def,Return_def,S_def,S5_def]));
  14.300 -qed "S5Hist";
  14.301 -
  14.302 -(* ------------------------------ State S6 ---------------------------------------- *)
  14.303 -
  14.304 -Goal "|- [ENext p]_(e p) & $(S6 rmhist p) --> unchanged (e p)";
  14.305 -by (auto_tac (MI_css addsimps2 [S_def,S6_def] addSDs2 [Envbusy]));
  14.306 -qed "S6EnvUnch";
  14.307 -
  14.308 -Goal "|- MClkNext memCh crCh cst p & $(S6 rmhist p) \
  14.309 -\        --> MClkRetry memCh crCh cst p | MClkReply memCh crCh cst p";
  14.310 -by (auto_tac (MI_css addsimps2 [MClkNext_def,MClkFwd_def,S_def,S6_def]));
  14.311 -qed "S6Clerk";
  14.312 -
  14.313 -Goal "|- MClkRetry memCh crCh cst p & HNext rmhist p & $S6 rmhist p\
  14.314 -\        & unchanged (e p,r p,m p) \
  14.315 -\        --> (S3 rmhist p)$ & unchanged (rmhist!p)";
  14.316 -by (action_simp_tac
  14.317 -      (simpset() addsimps [HNext_def,MClkReply_def,MClkRetry_def,Call_def,
  14.318 -	                   Return_def,e_def,r_def,m_def,caller_def,rtrner_def,
  14.319 -                           S_def,S6_def,S3_def,Calling_def])
  14.320 -      [] [] 1);
  14.321 -qed "S6Retry";
  14.322 -
  14.323 -Goal "|- MClkReply memCh crCh cst p & HNext rmhist p & $S6 rmhist p\
  14.324 -\        & unchanged (e p,r p,m p) \
  14.325 -\        --> (S1 rmhist p)$";
  14.326 -by (action_simp_tac 
  14.327 -      (simpset() addsimps [HNext_def,MemReturn_def,RPCFail_def,Return_def,
  14.328 -		           MClkReply_def,e_def,r_def,m_def,caller_def,rtrner_def,
  14.329 -                           S_def,S6_def,S1_def,Calling_def])
  14.330 -      [] [] 1);
  14.331 -qed "S6Reply";
  14.332 -
  14.333 -Goal "|- [RPCNext crCh rmCh rst p]_(r p) & $S6 rmhist p --> unchanged (r p)";
  14.334 -by (auto_tac (MI_css addsimps2 [S_def,S6_def] addSDs2 [RPCidle]));
  14.335 -qed "S6RPCUnch";
  14.336 -
  14.337 -Goal "|- [RNext rmCh mm ires p]_(m p) & $(S6 rmhist p) --> unchanged (m p)";
  14.338 -by (auto_tac (MI_css addsimps2 [S_def,S6_def] addSDs2 [Memoryidle]));
  14.339 -qed "S6MemUnch";
  14.340 -
  14.341 -Goal "|- HNext rmhist p & $S6 rmhist p & (c p)$ = $(c p) --> (rmhist!p)$ = $(rmhist!p)";
  14.342 -by (auto_tac (MI_css addsimps2 [HNext_def,MClkReply_def,Return_def,c_def,rtrner_def,
  14.343 -		                S_def,S6_def,Calling_def]));
  14.344 -qed "S6Hist";
    15.1 --- a/src/HOL/TLA/Memory/MemClerk.ML	Fri Dec 01 17:22:33 2006 +0100
    15.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    15.3 @@ -1,58 +0,0 @@
    15.4 -(*
    15.5 -    File:        MemClerk.ML
    15.6 -    ID:          $Id$
    15.7 -    Author:      Stephan Merz
    15.8 -    Copyright:   1997 University of Munich
    15.9 -
   15.10 -    RPC-Memory example: Memory clerk specification (theorems and proofs)
   15.11 -*)
   15.12 -
   15.13 -val MC_action_defs =
   15.14 -   [MClkInit_def, MClkFwd_def, MClkRetry_def, MClkReply_def, MClkNext_def];
   15.15 -
   15.16 -val MC_temp_defs = [MClkIPSpec_def, MClkISpec_def];
   15.17 -
   15.18 -val mem_css = (claset(), simpset());
   15.19 -
   15.20 -(* The Clerk engages in an action for process p only if there is an outstanding,
   15.21 -   unanswered call for that process.
   15.22 -*)
   15.23 -Goal "|- ~$Calling send p & $(cst!p) = #clkA --> ~MClkNext send rcv cst p";
   15.24 -by (auto_tac (mem_css addsimps2 (Return_def::MC_action_defs)));
   15.25 -qed "MClkidle";
   15.26 -
   15.27 -Goal "|- $Calling rcv p --> ~MClkNext send rcv cst p";
   15.28 -by (auto_tac (mem_css addsimps2 (Call_def::MC_action_defs)));
   15.29 -qed "MClkbusy";
   15.30 -
   15.31 -(* Enabledness of actions *)
   15.32 -
   15.33 -Goal "!!p. basevars (rtrner send!p, caller rcv!p, cst!p) ==> \
   15.34 -\     |- Calling send p & ~Calling rcv p & cst!p = #clkA  \
   15.35 -\        --> Enabled (MClkFwd send rcv cst p)";
   15.36 -by (action_simp_tac (simpset() addsimps [MClkFwd_def,Call_def,caller_def,rtrner_def])
   15.37 -                    [exI] [base_enabled,Pair_inject] 1);
   15.38 -qed "MClkFwd_enabled";
   15.39 -
   15.40 -Goal "|- Enabled (MClkFwd send rcv cst p)  -->  \
   15.41 -\        Enabled (<MClkFwd send rcv cst p>_(cst!p, rtrner send!p, caller rcv!p))";
   15.42 -by (auto_tac (mem_css addSEs2 [enabled_mono] addsimps2 [angle_def,MClkFwd_def]));
   15.43 -qed "MClkFwd_ch_enabled";
   15.44 -
   15.45 -Goal "|- MClkReply send rcv cst p --> \
   15.46 -\        <MClkReply send rcv cst p>_(cst!p, rtrner send!p, caller rcv!p)";
   15.47 -by (auto_tac (mem_css addsimps2 [angle_def,MClkReply_def]
   15.48 -                      addEs2 [Return_changed]));
   15.49 -qed "MClkReply_change";
   15.50 -
   15.51 -Goal "!!p. basevars (rtrner send!p, caller rcv!p, cst!p) ==> \
   15.52 -\     |- Calling send p & ~Calling rcv p & cst!p = #clkB  \
   15.53 -\        --> Enabled (<MClkReply send rcv cst p>_(cst!p, rtrner send!p, caller rcv!p))";
   15.54 -by (action_simp_tac (simpset()) [MClkReply_change RSN (2,enabled_mono)] [] 1);
   15.55 -by (action_simp_tac (simpset() addsimps [MClkReply_def,Return_def,caller_def,rtrner_def])
   15.56 -                    [exI] [base_enabled,Pair_inject] 1);
   15.57 -qed "MClkReply_enabled";
   15.58 -
   15.59 -Goal "|- MClkReply send rcv cst p --> ~MClkRetry send rcv cst p";
   15.60 -by (auto_tac (mem_css addsimps2 [MClkReply_def,MClkRetry_def]));
   15.61 -qed "MClkReplyNotRetry";
    16.1 --- a/src/HOL/TLA/Memory/MemClerk.thy	Fri Dec 01 17:22:33 2006 +0100
    16.2 +++ b/src/HOL/TLA/Memory/MemClerk.thy	Sat Dec 02 02:52:02 2006 +0100
    16.3 @@ -3,12 +3,9 @@
    16.4      ID:          $Id$
    16.5      Author:      Stephan Merz
    16.6      Copyright:   1997 University of Munich
    16.7 +*)
    16.8  
    16.9 -    Theory Name: MemClerk
   16.10 -    Logic Image: TLA
   16.11 -
   16.12 -    RPC-Memory example: specification of the memory clerk.
   16.13 -*)
   16.14 +header {* RPC-Memory example: specification of the memory clerk *}
   16.15  
   16.16  theory MemClerk
   16.17  imports Memory RPC MemClerkParameters
   16.18 @@ -67,6 +64,49 @@
   16.19    MClkISpec     :: "mClkSndChType => mClkRcvChType => mClkStType => temporal"
   16.20        "MClkISpec send rcv cst == TEMP (ALL p. MClkIPSpec send rcv cst p)"
   16.21  
   16.22 -ML {* use_legacy_bindings (the_context ()) *}
   16.23 +lemmas MC_action_defs =
   16.24 +  MClkInit_def MClkFwd_def MClkRetry_def MClkReply_def MClkNext_def
   16.25 +
   16.26 +lemmas MC_temp_defs = MClkIPSpec_def MClkISpec_def
   16.27 +
   16.28 +(* The Clerk engages in an action for process p only if there is an outstanding,
   16.29 +   unanswered call for that process.
   16.30 +*)
   16.31 +lemma MClkidle: "|- ~$Calling send p & $(cst!p) = #clkA --> ~MClkNext send rcv cst p"
   16.32 +  by (auto simp: Return_def MC_action_defs)
   16.33 +
   16.34 +lemma MClkbusy: "|- $Calling rcv p --> ~MClkNext send rcv cst p"
   16.35 +  by (auto simp: Call_def MC_action_defs)
   16.36 +
   16.37 +
   16.38 +(* Enabledness of actions *)
   16.39 +
   16.40 +lemma MClkFwd_enabled: "!!p. basevars (rtrner send!p, caller rcv!p, cst!p) ==>  
   16.41 +      |- Calling send p & ~Calling rcv p & cst!p = #clkA   
   16.42 +         --> Enabled (MClkFwd send rcv cst p)"
   16.43 +  by (tactic {* action_simp_tac (simpset () addsimps [thm "MClkFwd_def",
   16.44 +    thm "Call_def", thm "caller_def", thm "rtrner_def"]) [exI]
   16.45 +    [thm "base_enabled", Pair_inject] 1 *})
   16.46 +
   16.47 +lemma MClkFwd_ch_enabled: "|- Enabled (MClkFwd send rcv cst p)  -->   
   16.48 +         Enabled (<MClkFwd send rcv cst p>_(cst!p, rtrner send!p, caller rcv!p))"
   16.49 +  by (auto elim!: enabled_mono simp: angle_def MClkFwd_def)
   16.50 +
   16.51 +lemma MClkReply_change: "|- MClkReply send rcv cst p -->  
   16.52 +         <MClkReply send rcv cst p>_(cst!p, rtrner send!p, caller rcv!p)"
   16.53 +  by (auto simp: angle_def MClkReply_def elim: Return_changed [temp_use])
   16.54 +
   16.55 +lemma MClkReply_enabled: "!!p. basevars (rtrner send!p, caller rcv!p, cst!p) ==>  
   16.56 +      |- Calling send p & ~Calling rcv p & cst!p = #clkB   
   16.57 +         --> Enabled (<MClkReply send rcv cst p>_(cst!p, rtrner send!p, caller rcv!p))"
   16.58 +  apply (tactic {* action_simp_tac (simpset ())
   16.59 +    [thm "MClkReply_change" RSN (2, thm "enabled_mono") ] [] 1 *})
   16.60 +  apply (tactic {* action_simp_tac (simpset () addsimps
   16.61 +    [thm "MClkReply_def", thm "Return_def", thm "caller_def", thm "rtrner_def"])
   16.62 +    [exI] [thm "base_enabled", Pair_inject] 1 *})
   16.63 +  done
   16.64 +
   16.65 +lemma MClkReplyNotRetry: "|- MClkReply send rcv cst p --> ~MClkRetry send rcv cst p"
   16.66 +  by (auto simp: MClkReply_def MClkRetry_def)
   16.67  
   16.68  end
    17.1 --- a/src/HOL/TLA/Memory/MemClerkParameters.ML	Fri Dec 01 17:22:33 2006 +0100
    17.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    17.3 @@ -1,12 +0,0 @@
    17.4 -(*
    17.5 -    File:        MemClerkParameters.ML
    17.6 -    ID:          $Id$
    17.7 -    Author:      Stephan Merz
    17.8 -    Copyright:   1997 University of Munich
    17.9 -
   17.10 -    RPC-Memory example: Memory clerk parameters (ML file)
   17.11 -*)
   17.12 -
   17.13 -(*
   17.14 -val CP_simps = RP_simps @ mClkState.simps;
   17.15 -*)
    18.1 --- a/src/HOL/TLA/Memory/MemClerkParameters.thy	Fri Dec 01 17:22:33 2006 +0100
    18.2 +++ b/src/HOL/TLA/Memory/MemClerkParameters.thy	Sat Dec 02 02:52:02 2006 +0100
    18.3 @@ -3,12 +3,9 @@
    18.4      ID:          $Id$
    18.5      Author:      Stephan Merz
    18.6      Copyright:   1997 University of Munich
    18.7 +*)
    18.8  
    18.9 -    Theory Name: MemClerkParameters
   18.10 -    Logic Image: TLA
   18.11 -
   18.12 -    RPC-Memory example: Parameters of the memory clerk.
   18.13 -*)
   18.14 +header {* RPC-Memory example: Parameters of the memory clerk *}
   18.15  
   18.16  theory MemClerkParameters
   18.17  imports RPCParameters
   18.18 @@ -30,6 +27,4 @@
   18.19    MClkReplyVal     :: "Vals => Vals"
   18.20      "MClkReplyVal v == if v = RPCFailure then MemFailure else v"
   18.21  
   18.22 -ML {* use_legacy_bindings (the_context ()) *}
   18.23 -
   18.24  end
    19.1 --- a/src/HOL/TLA/Memory/Memory.ML	Fri Dec 01 17:22:33 2006 +0100
    19.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    19.3 @@ -1,126 +0,0 @@
    19.4 -(*
    19.5 -    File:        Memory.ML
    19.6 -    ID:          $Id$
    19.7 -    Author:      Stephan Merz
    19.8 -    Copyright:   1997 University of Munich
    19.9 -
   19.10 -    RPC-Memory example: Memory specification (theorems and proofs)
   19.11 -*)
   19.12 -
   19.13 -val RM_action_defs =
   19.14 -   [MInit_def, PInit_def, RdRequest_def, WrRequest_def, MemInv_def,
   19.15 -    GoodRead_def, BadRead_def, ReadInner_def, Read_def,
   19.16 -    GoodWrite_def, BadWrite_def, WriteInner_def, Write_def,
   19.17 -    MemReturn_def, RNext_def];
   19.18 -
   19.19 -val UM_action_defs = RM_action_defs @ [MemFail_def, UNext_def];
   19.20 -
   19.21 -val RM_temp_defs = [RPSpec_def, MSpec_def, IRSpec_def];
   19.22 -val UM_temp_defs = [UPSpec_def, MSpec_def, IUSpec_def];
   19.23 -
   19.24 -val mem_css = (claset(), simpset());
   19.25 -
   19.26 -(* -------------------- Proofs ---------------------------------------------- *)
   19.27 -
   19.28 -(* The reliable memory is an implementation of the unreliable one *)
   19.29 -Goal "|- IRSpec ch mm rs --> IUSpec ch mm rs";
   19.30 -by (force_tac (temp_css addsimps2 ([UNext_def,UPSpec_def,IUSpec_def] @ RM_temp_defs)
   19.31 -                        addSEs2 [STL4E,squareE]) 1);
   19.32 -qed "ReliableImplementsUnReliable";
   19.33 -
   19.34 -(* The memory spec implies the memory invariant *)
   19.35 -Goal "|- MSpec ch mm rs l --> [](MemInv mm l)";
   19.36 -by (auto_inv_tac (simpset() addsimps RM_temp_defs @ RM_action_defs) 1);
   19.37 -qed "MemoryInvariant";
   19.38 -
   19.39 -(* The invariant is trivial for non-locations *)
   19.40 -Goal "|- #l ~: #MemLoc --> [](MemInv mm l)";
   19.41 -by (auto_tac (temp_css addsimps2 [MemInv_def] addSIs2 [necT]));
   19.42 -qed "NonMemLocInvariant";
   19.43 -
   19.44 -Goal "|- (ALL l. #l : #MemLoc --> MSpec ch mm rs l) --> (ALL l. [](MemInv mm l))";
   19.45 -by (step_tac temp_cs 1);
   19.46 -by (case_tac "l : MemLoc" 1);
   19.47 -by (auto_tac (temp_css addSEs2 [MemoryInvariant,NonMemLocInvariant]));
   19.48 -qed "MemoryInvariantAll";
   19.49 -
   19.50 -(* The memory engages in an action for process p only if there is an
   19.51 -   unanswered call from p.
   19.52 -   We need this only for the reliable memory.
   19.53 -*)
   19.54 -
   19.55 -Goal "|- ~$(Calling ch p) --> ~ RNext ch mm rs p";
   19.56 -by (auto_tac (mem_css addsimps2 (Return_def::RM_action_defs)));
   19.57 -qed "Memoryidle";
   19.58 -
   19.59 -(* Enabledness conditions *)
   19.60 -
   19.61 -Goal "|- MemReturn ch rs p --> <MemReturn ch rs p>_(rtrner ch ! p, rs!p)";
   19.62 -by (force_tac (mem_css addsimps2 [MemReturn_def,angle_def]) 1);
   19.63 -qed "MemReturn_change";
   19.64 -
   19.65 -Goal "!!p. basevars (rtrner ch ! p, rs!p) ==> \
   19.66 -\     |- Calling ch p & (rs!p ~= #NotAResult) \
   19.67 -\        --> Enabled (<MemReturn ch rs p>_(rtrner ch ! p, rs!p))";
   19.68 -by (action_simp_tac (simpset()) [MemReturn_change RSN (2,enabled_mono)] [] 1);
   19.69 -by (action_simp_tac (simpset() addsimps [MemReturn_def,Return_def,rtrner_def])
   19.70 -                    [exI] [base_enabled,Pair_inject] 1);
   19.71 -qed "MemReturn_enabled";
   19.72 -
   19.73 -Goal "!!p. basevars (rtrner ch ! p, rs!p) ==> \
   19.74 -\     |- Calling ch p & (arg<ch!p> = #(read l)) --> Enabled (ReadInner ch mm rs p l)";
   19.75 -by (case_tac "l : MemLoc" 1);
   19.76 -by (ALLGOALS
   19.77 -     (force_tac (mem_css addsimps2 [ReadInner_def,GoodRead_def,
   19.78 -                                    BadRead_def,RdRequest_def]
   19.79 -                         addSIs2 [exI] addSEs2 [base_enabled])));
   19.80 -qed "ReadInner_enabled";
   19.81 -
   19.82 -Goal "!!p. basevars (mm!l, rtrner ch ! p, rs!p) ==> \
   19.83 -\     |- Calling ch p & (arg<ch!p> = #(write l v)) \
   19.84 -\        --> Enabled (WriteInner ch mm rs p l v)";
   19.85 -by (case_tac "l:MemLoc & v:MemVal" 1);
   19.86 -by (ALLGOALS
   19.87 -     (force_tac (mem_css addsimps2 [WriteInner_def,GoodWrite_def,
   19.88 -                                    BadWrite_def,WrRequest_def]
   19.89 -                         addSIs2 [exI] addSEs2 [base_enabled])));
   19.90 -qed "WriteInner_enabled";
   19.91 -
   19.92 -Goal "|- Read ch mm rs p & (!l. $(MemInv mm l)) --> (rs!p)` ~= #NotAResult";
   19.93 -by (force_tac (mem_css addsimps2
   19.94 -                       [Read_def,ReadInner_def,GoodRead_def,BadRead_def,MemInv_def]) 1);
   19.95 -qed "ReadResult";
   19.96 -
   19.97 -Goal "|- Write ch mm rs p l --> (rs!p)` ~= #NotAResult";
   19.98 -by (auto_tac (mem_css addsimps2 ([Write_def,WriteInner_def,GoodWrite_def,BadWrite_def])));
   19.99 -qed "WriteResult";
  19.100 -
  19.101 -Goal "|- (ALL l. $MemInv mm l) & MemReturn ch rs p \
  19.102 -\        --> ~ Read ch mm rs p & (ALL l. ~ Write ch mm rs p l)";
  19.103 -by (auto_tac (mem_css addsimps2 [MemReturn_def] addSDs2 [WriteResult, ReadResult]));
  19.104 -qed "ReturnNotReadWrite";
  19.105 -
  19.106 -Goal "|- (rs!p = #NotAResult) & (!l. MemInv mm l)  \
  19.107 -\        & Enabled (Read ch mm rs p | (? l. Write ch mm rs p l)) \
  19.108 -\        --> Enabled (<RNext ch mm rs p>_(rtrner ch ! p, rs!p))";
  19.109 -by (force_tac (mem_css addsimps2 [RNext_def,angle_def]
  19.110 -                       addSEs2 [enabled_mono2]
  19.111 -                       addDs2 [ReadResult, WriteResult]) 1);
  19.112 -qed "RWRNext_enabled";
  19.113 -
  19.114 -
  19.115 -(* Combine previous lemmas: the memory can make a visible step if there is an
  19.116 -   outstanding call for which no result has been produced.
  19.117 -*)
  19.118 -Goal "!!p. !l. basevars (mm!l, rtrner ch!p, rs!p) ==> \
  19.119 -\     |- (rs!p = #NotAResult) & Calling ch p & (!l. MemInv mm l)  \
  19.120 -\        --> Enabled (<RNext ch mm rs p>_(rtrner ch ! p, rs!p))";
  19.121 -by (auto_tac (mem_css addsimps2 [enabled_disj] addSIs2 [RWRNext_enabled]));
  19.122 -by (case_tac "arg(ch w p)" 1);
  19.123 - by (action_simp_tac (simpset()addsimps[Read_def,enabled_ex])
  19.124 -                     [ReadInner_enabled,exI] [] 1);
  19.125 - by (force_tac (mem_css addDs2 [base_pair]) 1);
  19.126 -by (etac contrapos_np 1);
  19.127 -by (action_simp_tac (simpset() addsimps [Write_def,enabled_ex])
  19.128 -                    [WriteInner_enabled,exI] [] 1);
  19.129 -qed "RNext_enabled";
    20.1 --- a/src/HOL/TLA/Memory/Memory.thy	Fri Dec 01 17:22:33 2006 +0100
    20.2 +++ b/src/HOL/TLA/Memory/Memory.thy	Sat Dec 02 02:52:02 2006 +0100
    20.3 @@ -3,12 +3,9 @@
    20.4      ID:          $Id$
    20.5      Author:      Stephan Merz
    20.6      Copyright:   1997 University of Munich
    20.7 +*)
    20.8  
    20.9 -    Theory Name: Memory
   20.10 -    Logic Image: TLA
   20.11 -
   20.12 -    RPC-Memory example: Memory specification
   20.13 -*)
   20.14 +header {* RPC-Memory example: Memory specification *}
   20.15  
   20.16  theory Memory
   20.17  imports MemoryParameters ProcedureInterface
   20.18 @@ -136,6 +133,108 @@
   20.19  
   20.20    MemInv_def:        "MemInv mm l == PRED  #l : #MemLoc --> mm!l : #MemVal"
   20.21  
   20.22 -ML {* use_legacy_bindings (the_context ()) *}
   20.23 +lemmas RM_action_defs =
   20.24 +  MInit_def PInit_def RdRequest_def WrRequest_def MemInv_def
   20.25 +  GoodRead_def BadRead_def ReadInner_def Read_def
   20.26 +  GoodWrite_def BadWrite_def WriteInner_def Write_def
   20.27 +  MemReturn_def RNext_def
   20.28 +
   20.29 +lemmas UM_action_defs = RM_action_defs MemFail_def UNext_def
   20.30 +
   20.31 +lemmas RM_temp_defs = RPSpec_def MSpec_def IRSpec_def
   20.32 +lemmas UM_temp_defs = UPSpec_def MSpec_def IUSpec_def
   20.33 +
   20.34 +
   20.35 +(* The reliable memory is an implementation of the unreliable one *)
   20.36 +lemma ReliableImplementsUnReliable: "|- IRSpec ch mm rs --> IUSpec ch mm rs"
   20.37 +  by (force simp: UNext_def UPSpec_def IUSpec_def RM_temp_defs elim!: STL4E [temp_use] squareE)
   20.38 +
   20.39 +(* The memory spec implies the memory invariant *)
   20.40 +lemma MemoryInvariant: "|- MSpec ch mm rs l --> [](MemInv mm l)"
   20.41 +  by (tactic {* auto_inv_tac
   20.42 +    (simpset () addsimps (thms "RM_temp_defs" @ thms "RM_action_defs")) 1 *})
   20.43 +
   20.44 +(* The invariant is trivial for non-locations *)
   20.45 +lemma NonMemLocInvariant: "|- #l ~: #MemLoc --> [](MemInv mm l)"
   20.46 +  by (auto simp: MemInv_def intro!: necT [temp_use])
   20.47 +
   20.48 +lemma MemoryInvariantAll:
   20.49 +    "|- (ALL l. #l : #MemLoc --> MSpec ch mm rs l) --> (ALL l. [](MemInv mm l))"
   20.50 +  apply clarify
   20.51 +  apply (case_tac "l : MemLoc")
   20.52 +  apply (auto elim!: MemoryInvariant [temp_use] NonMemLocInvariant [temp_use])
   20.53 +  done
   20.54 +
   20.55 +(* The memory engages in an action for process p only if there is an
   20.56 +   unanswered call from p.
   20.57 +   We need this only for the reliable memory.
   20.58 +*)
   20.59 +
   20.60 +lemma Memoryidle: "|- ~$(Calling ch p) --> ~ RNext ch mm rs p"
   20.61 +  by (auto simp: Return_def RM_action_defs)
   20.62 +
   20.63 +(* Enabledness conditions *)
   20.64 +
   20.65 +lemma MemReturn_change: "|- MemReturn ch rs p --> <MemReturn ch rs p>_(rtrner ch ! p, rs!p)"
   20.66 +  by (force simp: MemReturn_def angle_def)
   20.67 +
   20.68 +lemma MemReturn_enabled: "!!p. basevars (rtrner ch ! p, rs!p) ==>
   20.69 +      |- Calling ch p & (rs!p ~= #NotAResult)
   20.70 +         --> Enabled (<MemReturn ch rs p>_(rtrner ch ! p, rs!p))"
   20.71 +  apply (tactic
   20.72 +    {* action_simp_tac (simpset ()) [thm "MemReturn_change" RSN (2, thm "enabled_mono") ] [] 1 *})
   20.73 +  apply (tactic
   20.74 +    {* action_simp_tac (simpset () addsimps [thm "MemReturn_def", thm "Return_def",
   20.75 +      thm "rtrner_def"]) [exI] [thm "base_enabled", thm "Pair_inject"] 1 *})
   20.76 +  done
   20.77 +
   20.78 +lemma ReadInner_enabled: "!!p. basevars (rtrner ch ! p, rs!p) ==>
   20.79 +      |- Calling ch p & (arg<ch!p> = #(read l)) --> Enabled (ReadInner ch mm rs p l)"
   20.80 +  apply (case_tac "l : MemLoc")
   20.81 +  apply (force simp: ReadInner_def GoodRead_def BadRead_def RdRequest_def
   20.82 +    intro!: exI elim!: base_enabled [temp_use])+
   20.83 +  done
   20.84 +
   20.85 +lemma WriteInner_enabled: "!!p. basevars (mm!l, rtrner ch ! p, rs!p) ==>
   20.86 +      |- Calling ch p & (arg<ch!p> = #(write l v))
   20.87 +         --> Enabled (WriteInner ch mm rs p l v)"
   20.88 +  apply (case_tac "l:MemLoc & v:MemVal")
   20.89 +  apply (force simp: WriteInner_def GoodWrite_def BadWrite_def WrRequest_def
   20.90 +    intro!: exI elim!: base_enabled [temp_use])+
   20.91 +  done
   20.92 +
   20.93 +lemma ReadResult: "|- Read ch mm rs p & (!l. $(MemInv mm l)) --> (rs!p)` ~= #NotAResult"
   20.94 +  by (force simp: Read_def ReadInner_def GoodRead_def BadRead_def MemInv_def)
   20.95 +
   20.96 +lemma WriteResult: "|- Write ch mm rs p l --> (rs!p)` ~= #NotAResult"
   20.97 +  by (auto simp: Write_def WriteInner_def GoodWrite_def BadWrite_def)
   20.98 +
   20.99 +lemma ReturnNotReadWrite: "|- (ALL l. $MemInv mm l) & MemReturn ch rs p
  20.100 +         --> ~ Read ch mm rs p & (ALL l. ~ Write ch mm rs p l)"
  20.101 +  by (auto simp: MemReturn_def dest!: WriteResult [temp_use] ReadResult [temp_use])
  20.102 +
  20.103 +lemma RWRNext_enabled: "|- (rs!p = #NotAResult) & (!l. MemInv mm l)
  20.104 +         & Enabled (Read ch mm rs p | (? l. Write ch mm rs p l))
  20.105 +         --> Enabled (<RNext ch mm rs p>_(rtrner ch ! p, rs!p))"
  20.106 +  by (force simp: RNext_def angle_def elim!: enabled_mono2
  20.107 +    dest: ReadResult [temp_use] WriteResult [temp_use])
  20.108 +
  20.109 +
  20.110 +(* Combine previous lemmas: the memory can make a visible step if there is an
  20.111 +   outstanding call for which no result has been produced.
  20.112 +*)
  20.113 +lemma RNext_enabled: "!!p. !l. basevars (mm!l, rtrner ch!p, rs!p) ==>
  20.114 +      |- (rs!p = #NotAResult) & Calling ch p & (!l. MemInv mm l)
  20.115 +         --> Enabled (<RNext ch mm rs p>_(rtrner ch ! p, rs!p))"
  20.116 +  apply (auto simp: enabled_disj [try_rewrite] intro!: RWRNext_enabled [temp_use])
  20.117 +  apply (case_tac "arg (ch w p)")
  20.118 +   apply (tactic {* action_simp_tac (simpset () addsimps [thm "Read_def",
  20.119 +     temp_rewrite (thm "enabled_ex")]) [thm "ReadInner_enabled", exI] [] 1 *})
  20.120 +   apply (force dest: base_pair [temp_use])
  20.121 +  apply (erule contrapos_np)
  20.122 +  apply (tactic {* action_simp_tac (simpset () addsimps [thm "Write_def",
  20.123 +    temp_rewrite (thm "enabled_ex")])
  20.124 +    [thm "WriteInner_enabled", exI] [] 1 *})
  20.125 +  done
  20.126  
  20.127  end
    21.1 --- a/src/HOL/TLA/Memory/MemoryImplementation.ML	Fri Dec 01 17:22:33 2006 +0100
    21.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    21.3 @@ -1,904 +0,0 @@
    21.4 -(*
    21.5 -    File:        MemoryImplementation.ML
    21.6 -    ID:          $Id$
    21.7 -    Author:      Stephan Merz
    21.8 -    Copyright:   1997 University of Munich
    21.9 -
   21.10 -    RPC-Memory example: Memory implementation (ML file)
   21.11 -
   21.12 -    The main theorem is theorem "Implementation" at the end of this file,
   21.13 -    which shows that the composition of a reliable memory, an RPC component, and
   21.14 -    a memory clerk implements an unreliable memory. The files "MIsafe.ML" and
   21.15 -    "MIlive.ML" contain lower-level lemmas for the safety and liveness parts.
   21.16 -
   21.17 -    Steps are (roughly) numbered as in the hand proof.
   21.18 -*)
   21.19 -
   21.20 -(* --------------------------- automatic prover --------------------------- *)
   21.21 -
   21.22 -Delcongs [if_weak_cong];
   21.23 -
   21.24 -val MI_css = (claset(), simpset());
   21.25 -
   21.26 -(* A more aggressive variant that tries to solve subgoals by assumption
   21.27 -   or contradiction during the simplification.
   21.28 -   THIS IS UNSAFE, BECAUSE IT DOESN'T RECORD THE CHOICES!!
   21.29 -   (but it can be a lot faster than MI_css)
   21.30 -*)
   21.31 -val MI_fast_css =
   21.32 -  let
   21.33 -    val (cs,ss) = MI_css
   21.34 -  in
   21.35 -    (cs addSEs [squareE], ss addSSolver (mk_solver "" (fn thms => assume_tac ORELSE' (etac notE))))
   21.36 -end;
   21.37 -
   21.38 -val temp_elim = make_elim o temp_use;
   21.39 -
   21.40 -(****************************** The history variable ******************************)
   21.41 -section "History variable";
   21.42 -
   21.43 -Goal "|- Init(ALL p. ImpInit p) & [](ALL p. ImpNext p)  \
   21.44 -\        --> (EEX rmhist. Init(ALL p. HInit rmhist p) \
   21.45 -\                         & [](ALL p. [HNext rmhist p]_(c p, r p, m p, rmhist!p)))";
   21.46 -by (Clarsimp_tac 1);
   21.47 -by (rtac historyI 1);
   21.48 -by (TRYALL atac);
   21.49 -by (rtac MI_base 1);
   21.50 -by (action_simp_tac (simpset() addsimps [HInit_def]) [] [] 1);
   21.51 -by (etac fun_cong 1);
   21.52 -by (action_simp_tac (simpset() addsimps [HNext_def]) [busy_squareI] [] 1);
   21.53 -by (etac fun_cong 1);
   21.54 -qed "HistoryLemma";
   21.55 -
   21.56 -Goal "|- Implementation --> (EEX rmhist. Hist rmhist)";
   21.57 -by (Clarsimp_tac 1);
   21.58 -by (rtac ((temp_use HistoryLemma) RS eex_mono) 1);
   21.59 -by (force_tac (MI_css
   21.60 -               addsimps2 [Hist_def,HistP_def,Init_def,all_box,split_box_conj]) 3);
   21.61 -by (auto_tac (MI_css
   21.62 -              addsimps2 [Implementation_def,MClkISpec_def,RPCISpec_def,IRSpec_def,
   21.63 -                         MClkIPSpec_def,RPCIPSpec_def,RPSpec_def,
   21.64 -                         ImpInit_def,Init_def,ImpNext_def,
   21.65 -                         c_def,r_def,m_def,all_box,split_box_conj]));
   21.66 -qed "History";
   21.67 -
   21.68 -(******************************** The safety part *********************************)
   21.69 -
   21.70 -section "The safety part";
   21.71 -
   21.72 -(* ------------------------- Include lower-level lemmas ------------------------- *)
   21.73 -use "MIsafe.ML";
   21.74 -
   21.75 -section "Correctness of predicate-action diagram";
   21.76 -
   21.77 -
   21.78 -(* ========== Step 1.1 ================================================= *)
   21.79 -(* The implementation's initial condition implies the state predicate S1 *)
   21.80 -
   21.81 -Goal "|- ImpInit p & HInit rmhist p --> S1 rmhist p";
   21.82 -by (auto_tac (MI_fast_css
   21.83 -              addsimps2 [MVNROKBA_def,MClkInit_def,RPCInit_def,PInit_def,
   21.84 -                         HInit_def,ImpInit_def,S_def,S1_def]));
   21.85 -qed "Step1_1";
   21.86 -
   21.87 -(* ========== Step 1.2 ================================================== *)
   21.88 -(* Figure 16 is a predicate-action diagram for the implementation. *)
   21.89 -
   21.90 -Goal "|- [HNext rmhist p]_(c p,r p,m p, rmhist!p) & ImpNext p  \
   21.91 -\        & ~unchanged (e p, c p, r p, m p, rmhist!p)  & $S1 rmhist p \
   21.92 -\        --> (S2 rmhist p)$ & ENext p & unchanged (c p, r p, m p)";
   21.93 -by (action_simp_tac (simpset() addsimps [ImpNext_def]) []
   21.94 -                    (map temp_elim [S1ClerkUnch,S1RPCUnch,S1MemUnch,S1Hist]) 1);
   21.95 -by (auto_tac (MI_fast_css addSIs2 [S1Env]));
   21.96 -qed "Step1_2_1";
   21.97 -
   21.98 -Goal "|- [HNext rmhist p]_(c p,r p,m p, rmhist!p) & ImpNext p  \
   21.99 -\        & ~unchanged (e p, c p, r p, m p, rmhist!p) & $S2 rmhist p \
  21.100 -\        --> (S3 rmhist p)$ & MClkFwd memCh crCh cst p\
  21.101 -\            & unchanged (e p, r p, m p, rmhist!p)";
  21.102 -by (action_simp_tac (simpset() addsimps [ImpNext_def]) []
  21.103 -                    (map temp_elim [S2EnvUnch,S2RPCUnch,S2MemUnch,S2Hist]) 1);
  21.104 -by (auto_tac (MI_fast_css addSIs2 [S2Clerk,S2Forward]));
  21.105 -qed "Step1_2_2";
  21.106 -
  21.107 -Goal "|- [HNext rmhist p]_(c p,r p,m p, rmhist!p) & ImpNext p  \
  21.108 -\        & ~unchanged (e p, c p, r p, m p, rmhist!p) & $S3 rmhist p \
  21.109 -\        --> ((S4 rmhist p)$ & RPCFwd crCh rmCh rst p & unchanged (e p, c p, m p, rmhist!p)) \
  21.110 -\            | ((S6 rmhist p)$ & RPCFail crCh rmCh rst p & unchanged (e p, c p, m p))";
  21.111 -by (action_simp_tac (simpset() addsimps [ImpNext_def]) []
  21.112 -                    (map temp_elim [S3EnvUnch,S3ClerkUnch,S3MemUnch]) 1);
  21.113 -by (action_simp_tac (simpset()) []
  21.114 -                    (squareE::map temp_elim [S3RPC,S3Forward,S3Fail]) 1);
  21.115 -by (auto_tac (MI_css addDs2 [S3Hist]));
  21.116 -qed "Step1_2_3";
  21.117 -
  21.118 -Goal "|- [HNext rmhist p]_(c p,r p,m p, rmhist!p) & ImpNext p  \
  21.119 -\             & ~unchanged (e p, c p, r p, m p, rmhist!p) \
  21.120 -\             & $S4 rmhist p & (!l. $(MemInv mm l))     \
  21.121 -\        --> ((S4 rmhist p)$ & Read rmCh mm ires p & unchanged (e p, c p, r p, rmhist!p)) \
  21.122 -\            | ((S4 rmhist p)$ & (? l. Write rmCh mm ires p l) & unchanged (e p, c p, r p, rmhist!p)) \
  21.123 -\            | ((S5 rmhist p)$ & MemReturn rmCh ires p & unchanged (e p, c p, r p))";
  21.124 -by (action_simp_tac (simpset() addsimps [ImpNext_def]) []
  21.125 -                    (map temp_elim [S4EnvUnch,S4ClerkUnch,S4RPCUnch]) 1);
  21.126 -by (action_simp_tac (simpset() addsimps [RNext_def]) []
  21.127 -                    (squareE::map temp_elim [S4Read,S4Write,S4Return]) 1);
  21.128 -by (auto_tac (MI_css addDs2 [S4Hist]));
  21.129 -qed "Step1_2_4";
  21.130 -
  21.131 -Goal "|- [HNext rmhist p]_(c p,r p,m p, rmhist!p) & ImpNext p  \
  21.132 -\             & ~unchanged (e p, c p, r p, m p, rmhist!p) & $S5 rmhist p \
  21.133 -\        --> ((S6 rmhist p)$ & RPCReply crCh rmCh rst p & unchanged (e p, c p, m p)) \
  21.134 -\            | ((S6 rmhist p)$ & RPCFail crCh rmCh rst p & unchanged (e p, c p, m p))";
  21.135 -by (action_simp_tac (simpset() addsimps [ImpNext_def]) []
  21.136 -                    (map temp_elim [S5EnvUnch,S5ClerkUnch,S5MemUnch,S5Hist]) 1);
  21.137 -by (action_simp_tac (simpset()) [] [squareE, temp_elim S5RPC] 1);
  21.138 -by (auto_tac (MI_fast_css addSDs2 [S5Reply,S5Fail]));
  21.139 -qed "Step1_2_5";
  21.140 -
  21.141 -Goal "|- [HNext rmhist p]_(c p,r p,m p, rmhist!p) & ImpNext p  \
  21.142 -\             & ~unchanged (e p, c p, r p, m p, rmhist!p) & $S6 rmhist p \
  21.143 -\        --> ((S1 rmhist p)$ & MClkReply memCh crCh cst p & unchanged (e p, r p, m p))\
  21.144 -\            | ((S3 rmhist p)$ & MClkRetry memCh crCh cst p & unchanged (e p,r p,m p,rmhist!p))";
  21.145 -by (action_simp_tac (simpset() addsimps [ImpNext_def]) []
  21.146 -                    (map temp_elim [S6EnvUnch,S6RPCUnch,S6MemUnch]) 1);
  21.147 -by (action_simp_tac (simpset()) []
  21.148 -                    (squareE::map temp_elim [S6Clerk,S6Retry,S6Reply]) 1);
  21.149 -by (auto_tac (MI_css addDs2 [S6Hist]));
  21.150 -qed "Step1_2_6";
  21.151 -
  21.152 -(* --------------------------------------------------------------------------
  21.153 -   Step 1.3: S1 implies the barred initial condition.
  21.154 -*)
  21.155 -
  21.156 -section "Initialization (Step 1.3)";
  21.157 -
  21.158 -Goal "|- S1 rmhist p --> PInit (resbar rmhist) p";
  21.159 -by (action_simp_tac (simpset() addsimps [resbar_def,PInit_def,S_def,S1_def])
  21.160 -                    [] [] 1);
  21.161 -qed "Step1_3";
  21.162 -
  21.163 -(* ----------------------------------------------------------------------
  21.164 -   Step 1.4: Implementation's next-state relation simulates specification's
  21.165 -             next-state relation (with appropriate substitutions)
  21.166 -*)
  21.167 -
  21.168 -section "Step simulation (Step 1.4)";
  21.169 -
  21.170 -Goal "|- ENext p & $S1 rmhist p & (S2 rmhist p)$ & unchanged (c p, r p, m p) \
  21.171 -\        --> unchanged (rtrner memCh!p, resbar rmhist!p)";
  21.172 -by (auto_tac (MI_fast_css addsimps2 [c_def,r_def,m_def,resbar_def]));
  21.173 -qed "Step1_4_1";
  21.174 -
  21.175 -Goal "|- MClkFwd memCh crCh cst p & $S2 rmhist p & (S3 rmhist p)$  \
  21.176 -\        & unchanged (e p, r p, m p, rmhist!p) \
  21.177 -\        --> unchanged (rtrner memCh!p, resbar rmhist!p)";
  21.178 -by (action_simp_tac
  21.179 -      (simpset() addsimps [MClkFwd_def, e_def, r_def, m_def, resbar_def,
  21.180 -                           S_def, S2_def, S3_def]) [] [] 1);
  21.181 -qed "Step1_4_2";
  21.182 -
  21.183 -Goal "|- RPCFwd crCh rmCh rst p & $S3 rmhist p & (S4 rmhist p)$    \
  21.184 -\        & unchanged (e p, c p, m p, rmhist!p) \
  21.185 -\        --> unchanged (rtrner memCh!p, resbar rmhist!p)";
  21.186 -by (Clarsimp_tac 1);
  21.187 -by (REPEAT (dresolve_tac (map temp_use [S3_excl,S4_excl]) 1));
  21.188 -by (action_simp_tac
  21.189 -      (simpset() addsimps [e_def,c_def,m_def,resbar_def,S_def, S3_def]) [] [] 1);
  21.190 -qed "Step1_4_3a";
  21.191 -
  21.192 -Goal "|- RPCFail crCh rmCh rst p & $S3 rmhist p & (S6 rmhist p)$\
  21.193 -\        & unchanged (e p, c p, m p) \
  21.194 -\        --> MemFail memCh (resbar rmhist) p";
  21.195 -by (Clarsimp_tac 1);
  21.196 -by (dtac (temp_use S6_excl) 1);
  21.197 -by (auto_tac (MI_css addsimps2 [RPCFail_def,MemFail_def,e_def,c_def,m_def,
  21.198 -                                resbar_def]));
  21.199 -by (force_tac (MI_css addsimps2 [S3_def,S_def]) 1);
  21.200 -by (auto_tac (MI_css addsimps2 [Return_def]));
  21.201 -qed "Step1_4_3b";
  21.202 -
  21.203 -Goal "|- $S4 rmhist p & (S4 rmhist p)$ & ReadInner rmCh mm ires p l \
  21.204 -\        & unchanged (e p, c p, r p, rmhist!p) & $MemInv mm l \
  21.205 -\        --> ReadInner memCh mm (resbar rmhist) p l";
  21.206 -by (Clarsimp_tac 1);
  21.207 -by (REPEAT (dtac (temp_use S4_excl) 1));
  21.208 -by (action_simp_tac
  21.209 -      (simpset() addsimps [ReadInner_def,GoodRead_def,BadRead_def,e_def,c_def,m_def])
  21.210 -      [] [] 1);
  21.211 -by (auto_tac (MI_css addsimps2 [resbar_def]));
  21.212 -by (ALLGOALS (action_simp_tac
  21.213 -                (simpset() addsimps [RPCRelayArg_def,MClkRelayArg_def,
  21.214 -                                     S_def,S4_def,RdRequest_def,MemInv_def])
  21.215 -                [] [impE,MemValNotAResultE]));
  21.216 -qed "Step1_4_4a1";
  21.217 -
  21.218 -Goal "|- Read rmCh mm ires p & $S4 rmhist p & (S4 rmhist p)$ \
  21.219 -\        & unchanged (e p, c p, r p, rmhist!p) & (!l. $(MemInv mm l)) \
  21.220 -\        --> Read memCh mm (resbar rmhist) p";
  21.221 -by (force_tac (MI_css addsimps2 [Read_def] addSEs2 [Step1_4_4a1]) 1);
  21.222 -qed "Step1_4_4a";
  21.223 -
  21.224 -Goal "|- $S4 rmhist p & (S4 rmhist p)$ & WriteInner rmCh mm ires p l v   \
  21.225 -\        & unchanged (e p, c p, r p, rmhist!p) \
  21.226 -\        --> WriteInner memCh mm (resbar rmhist) p l v";
  21.227 -by (Clarsimp_tac 1);
  21.228 -by (REPEAT (dtac (temp_use S4_excl) 1));
  21.229 -by (action_simp_tac
  21.230 -      (simpset() addsimps [WriteInner_def, GoodWrite_def, BadWrite_def,
  21.231 -                           e_def, c_def, m_def])
  21.232 -      [] [] 1);
  21.233 -by (auto_tac (MI_css addsimps2 [resbar_def]));
  21.234 -by (ALLGOALS (action_simp_tac
  21.235 -                (simpset() addsimps [RPCRelayArg_def,MClkRelayArg_def,
  21.236 -                                     S_def,S4_def,WrRequest_def])
  21.237 -                [] []));
  21.238 -qed "Step1_4_4b1";
  21.239 -
  21.240 -Goal "|- Write rmCh mm ires p l & $S4 rmhist p & (S4 rmhist p)$   \
  21.241 -\        & unchanged (e p, c p, r p, rmhist!p) \
  21.242 -\        --> Write memCh mm (resbar rmhist) p l";
  21.243 -by (force_tac (MI_css addsimps2 [Write_def] addSEs2 [Step1_4_4b1]) 1);
  21.244 -qed "Step1_4_4b";
  21.245 -
  21.246 -Goal "|- MemReturn rmCh ires p & $S4 rmhist p & (S5 rmhist p)$\
  21.247 -\        & unchanged (e p, c p, r p) \
  21.248 -\        --> unchanged (rtrner memCh!p, resbar rmhist!p)";
  21.249 -by (action_simp_tac
  21.250 -      (simpset() addsimps [e_def,c_def,r_def,resbar_def]) [] [] 1);
  21.251 -by (REPEAT (dresolve_tac [temp_use S4_excl, temp_use S5_excl] 1));
  21.252 -by (auto_tac (MI_fast_css addsimps2 [MemReturn_def,Return_def]));
  21.253 -qed "Step1_4_4c";
  21.254 -
  21.255 -Goal "|- RPCReply crCh rmCh rst p & $S5 rmhist p & (S6 rmhist p)$\
  21.256 -\        & unchanged (e p, c p, m p) \
  21.257 -\        --> unchanged (rtrner memCh!p, resbar rmhist!p)";
  21.258 -by (Clarsimp_tac 1);
  21.259 -by (REPEAT (dresolve_tac [temp_use S5_excl, temp_use S6_excl] 1));
  21.260 -by (auto_tac (MI_css addsimps2 [e_def,c_def,m_def, resbar_def]));
  21.261 -by (auto_tac (MI_css addsimps2 [RPCReply_def,Return_def,S5_def,S_def]
  21.262 -                     addSDs2 [MVOKBAnotRF]));
  21.263 -qed "Step1_4_5a";
  21.264 -
  21.265 -Goal "|- RPCFail crCh rmCh rst p & $S5 rmhist p & (S6 rmhist p)$\
  21.266 -\        & unchanged (e p, c p, m p) \
  21.267 -\        --> MemFail memCh (resbar rmhist) p";
  21.268 -by (Clarsimp_tac 1);
  21.269 -by (dtac (temp_use S6_excl) 1);
  21.270 -by (auto_tac (MI_css addsimps2 [e_def, c_def, m_def, RPCFail_def, Return_def,
  21.271 -                                MemFail_def, resbar_def]));
  21.272 -by (auto_tac (MI_css addsimps2 [S5_def,S_def]));
  21.273 -qed "Step1_4_5b";
  21.274 -
  21.275 -Goal "|- MClkReply memCh crCh cst p & $S6 rmhist p & (S1 rmhist p)$\
  21.276 -\        & unchanged (e p, r p, m p) \
  21.277 -\        --> MemReturn memCh (resbar rmhist) p";
  21.278 -by (Clarsimp_tac 1);
  21.279 -by (dtac (temp_use S6_excl) 1);
  21.280 -by (action_simp_tac
  21.281 -      (simpset() addsimps [e_def,r_def,m_def,MClkReply_def,MemReturn_def,
  21.282 -                           Return_def,resbar_def]) [] [] 1);
  21.283 -by (ALLGOALS Asm_full_simp_tac);  (* simplify if-then-else *)
  21.284 -by (ALLGOALS (action_simp_tac
  21.285 -                (simpset() addsimps [MClkReplyVal_def,S6_def,S_def])
  21.286 -                [] [MVOKBARFnotNR]));
  21.287 -qed "Step1_4_6a";
  21.288 -
  21.289 -Goal "|- MClkRetry memCh crCh cst p & $S6 rmhist p & (S3 rmhist p)$   \
  21.290 -\        & unchanged (e p, r p, m p, rmhist!p) \
  21.291 -\        --> MemFail memCh (resbar rmhist) p";
  21.292 -by (Clarsimp_tac 1);
  21.293 -by (dtac (temp_use S3_excl) 1);
  21.294 -by (action_simp_tac
  21.295 -      (simpset() addsimps [e_def, r_def, m_def, MClkRetry_def, MemFail_def, resbar_def])
  21.296 -      [] [] 1);
  21.297 -by (auto_tac (MI_css addsimps2 [S6_def,S_def]));
  21.298 -qed "Step1_4_6b";
  21.299 -
  21.300 -Goal "|- unchanged (e p, c p, r p, m p, rmhist!p) \
  21.301 -\        --> unchanged (S rmhist ec cc rc cs rs hs1 hs2 p)";
  21.302 -by (auto_tac (MI_css addsimps2 [e_def,c_def,r_def,m_def,caller_def,rtrner_def,
  21.303 -                                S_def,Calling_def]));
  21.304 -qed "S_lemma";
  21.305 -
  21.306 -Goal "|- unchanged (e p, c p, r p, m p, rmhist!p) \
  21.307 -\        --> unchanged (rtrner memCh!p, S1 rmhist p, S2 rmhist p, S3 rmhist p, \
  21.308 -\                       S4 rmhist p, S5 rmhist p, S6 rmhist p)";
  21.309 -by (Clarsimp_tac 1);
  21.310 -by (rtac conjI 1);
  21.311 -by (force_tac (MI_css addsimps2 [c_def]) 1);
  21.312 -by (force_tac (MI_css addsimps2 [S1_def,S2_def,S3_def,S4_def,S5_def,S6_def]
  21.313 -                      addSIs2 [S_lemma]) 1);
  21.314 -qed "Step1_4_7H";
  21.315 -
  21.316 -Goal "|- unchanged (e p, c p, r p, m p, rmhist!p) \
  21.317 -\        --> unchanged (rtrner memCh!p, resbar rmhist!p, S1 rmhist p, S2 rmhist p, \
  21.318 -\                       S3 rmhist p, S4 rmhist p, S5 rmhist p, S6 rmhist p)";
  21.319 -by (rtac actionI 1);
  21.320 -by (rewrite_goals_tac action_rews);
  21.321 -by (rtac impI 1);
  21.322 -by (forward_tac [temp_use Step1_4_7H] 1);
  21.323 -by (auto_tac (MI_css addsimps2 [e_def,c_def,r_def,m_def,rtrner_def,resbar_def]));
  21.324 -qed "Step1_4_7";
  21.325 -
  21.326 -(* Frequently needed abbreviation: distinguish between idling and non-idling
  21.327 -   steps of the implementation, and try to solve the idling case by simplification
  21.328 -*)
  21.329 -fun split_idle_tac simps i =
  21.330 -    EVERY [TRY (rtac actionI i),
  21.331 -           case_tac "(s,t) |= unchanged (e p, c p, r p, m p, rmhist!p)" i,
  21.332 -           rewrite_goals_tac action_rews,
  21.333 -           forward_tac [temp_use Step1_4_7] i,
  21.334 -           asm_full_simp_tac (simpset() addsimps simps) i
  21.335 -          ];
  21.336 -
  21.337 -(* ----------------------------------------------------------------------
  21.338 -   Combine steps 1.2 and 1.4 to prove that the implementation satisfies
  21.339 -   the specification's next-state relation.
  21.340 -*)
  21.341 -
  21.342 -(* Steps that leave all variables unchanged are safe, so I may assume
  21.343 -   that some variable changes in the proof that a step is safe. *)
  21.344 -Goal "|- (~unchanged (e p, c p, r p, m p, rmhist!p) \
  21.345 -\            --> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)) \
  21.346 -\        --> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)";
  21.347 -by (split_idle_tac [square_def] 1);
  21.348 -by (Force_tac 1);
  21.349 -qed "unchanged_safe";
  21.350 -(* turn into (unsafe, looping!) introduction rule *)
  21.351 -bind_thm("unchanged_safeI", impI RS (action_use unchanged_safe));
  21.352 -
  21.353 -Goal "|- $S1 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)   \
  21.354 -\        --> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)";
  21.355 -by (Clarsimp_tac 1);
  21.356 -by (rtac unchanged_safeI 1);
  21.357 -by (rtac idle_squareI 1);
  21.358 -by (auto_tac (MI_css addSDs2 [Step1_2_1,Step1_4_1]));
  21.359 -qed "S1safe";
  21.360 -
  21.361 -Goal "|- $S2 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)   \
  21.362 -\        --> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)";
  21.363 -by (Clarsimp_tac 1);
  21.364 -by (rtac unchanged_safeI 1);
  21.365 -by (rtac idle_squareI 1);
  21.366 -by (auto_tac (MI_css addSDs2 [Step1_2_2,Step1_4_2]));
  21.367 -qed "S2safe";
  21.368 -
  21.369 -Goal "|- $S3 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)   \
  21.370 -\        --> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)";
  21.371 -by (Clarsimp_tac 1);
  21.372 -by (rtac unchanged_safeI 1);
  21.373 -by (auto_tac (MI_css addSDs2 [Step1_2_3]));
  21.374 -by (auto_tac (MI_css addsimps2 [square_def,UNext_def] addSDs2 [Step1_4_3a,Step1_4_3b]));
  21.375 -qed "S3safe";
  21.376 -
  21.377 -Goal "|- $S4 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)  \
  21.378 -\        & (!l. $(MemInv mm l)) \
  21.379 -\        --> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)";
  21.380 -by (Clarsimp_tac 1);
  21.381 -by (rtac unchanged_safeI 1);
  21.382 -by (auto_tac (MI_css addSDs2 [Step1_2_4]));
  21.383 -by (auto_tac (MI_css addsimps2 [square_def,UNext_def,RNext_def]
  21.384 -                     addSDs2 [Step1_4_4a,Step1_4_4b,Step1_4_4c]));
  21.385 -qed "S4safe";
  21.386 -
  21.387 -Goal "|- $S5 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)  \
  21.388 -\        --> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)";
  21.389 -by (Clarsimp_tac 1);
  21.390 -by (rtac unchanged_safeI 1);
  21.391 -by (auto_tac (MI_css addSDs2 [Step1_2_5]));
  21.392 -by (auto_tac (MI_css addsimps2 [square_def,UNext_def]
  21.393 -                     addSDs2 [Step1_4_5a,Step1_4_5b]));
  21.394 -qed "S5safe";
  21.395 -
  21.396 -Goal "|- $S6 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)   \
  21.397 -\        --> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)";
  21.398 -by (Clarsimp_tac 1);
  21.399 -by (rtac unchanged_safeI 1);
  21.400 -by (auto_tac (MI_css addSDs2 [Step1_2_6]));
  21.401 -by (auto_tac (MI_css addsimps2 [square_def,UNext_def,RNext_def]
  21.402 -                     addSDs2 [Step1_4_6a,Step1_4_6b]));
  21.403 -qed "S6safe";
  21.404 -
  21.405 -(* ----------------------------------------------------------------------
  21.406 -   Step 1.5: Temporal refinement proof, based on previous steps.
  21.407 -*)
  21.408 -
  21.409 -section "The liveness part";
  21.410 -
  21.411 -(* Liveness assertions for the different implementation states, based on the
  21.412 -   fairness conditions. Prove subgoals of WF1 / SF1 rules as separate lemmas
  21.413 -   for readability. Reuse action proofs from safety part.
  21.414 -*)
  21.415 -
  21.416 -(* ------------------------------ State S1 ------------------------------ *)
  21.417 -
  21.418 -Goal "|- $S1 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)  \
  21.419 -\        --> (S1 rmhist p)$ | (S2 rmhist p)$";
  21.420 -by (split_idle_tac [] 1);
  21.421 -by (auto_tac (MI_css addSDs2 [Step1_2_1]));
  21.422 -qed "S1_successors";
  21.423 -
  21.424 -(* Show that the implementation can satisfy the high-level fairness requirements
  21.425 -   by entering the state S1 infinitely often.
  21.426 -*)
  21.427 -
  21.428 -Goal "|- S1 rmhist p --> \
  21.429 -\        ~Enabled (<RNext memCh mm (resbar rmhist) p>_(rtrner memCh!p, resbar rmhist!p))";
  21.430 -by (action_simp_tac (simpset() addsimps [angle_def,S_def,S1_def])
  21.431 -                    [notI] [enabledE,temp_elim Memoryidle] 1);
  21.432 -by (Force_tac 1);
  21.433 -qed "S1_RNextdisabled";
  21.434 -
  21.435 -Goal "|- S1 rmhist p --> \
  21.436 -\        ~Enabled (<MemReturn memCh (resbar rmhist) p>_(rtrner memCh!p, resbar rmhist!p))";
  21.437 -by (action_simp_tac
  21.438 -      (simpset() addsimps [angle_def,MemReturn_def,Return_def,S_def,S1_def])
  21.439 -      [notI] [enabledE] 1);
  21.440 -qed "S1_Returndisabled";
  21.441 -
  21.442 -Goal "|- []<>S1 rmhist p   \
  21.443 -\        --> WF(RNext memCh mm (resbar rmhist) p)_(rtrner memCh!p, resbar rmhist!p)";
  21.444 -by (auto_tac (MI_css addsimps2 [WF_alt]
  21.445 -                     addSIs2 [S1_RNextdisabled] addSEs2 [STL4E,DmdImplE]));
  21.446 -qed "RNext_fair";
  21.447 -
  21.448 -Goal "|- []<>S1 rmhist p   \
  21.449 -\        --> WF(MemReturn memCh (resbar rmhist) p)_(rtrner memCh!p, resbar rmhist!p)";
  21.450 -by (auto_tac (MI_css addsimps2 [WF_alt]
  21.451 -                     addSIs2 [S1_Returndisabled] addSEs2 [STL4E,DmdImplE]));
  21.452 -qed "Return_fair";
  21.453 -
  21.454 -(* ------------------------------ State S2 ------------------------------ *)
  21.455 -
  21.456 -Goal "|- $S2 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)   \
  21.457 -\        --> (S2 rmhist p)$ | (S3 rmhist p)$";
  21.458 -by (split_idle_tac [] 1);
  21.459 -by (auto_tac (MI_css addSDs2 [Step1_2_2]));
  21.460 -qed "S2_successors";
  21.461 -
  21.462 -Goal "|- ($S2 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p))\
  21.463 -\        & <MClkFwd memCh crCh cst p>_(c p) \
  21.464 -\        --> (S3 rmhist p)$";
  21.465 -by (auto_tac (MI_css addsimps2 [angle_def] addSDs2 [Step1_2_2]));
  21.466 -qed "S2MClkFwd_successors";
  21.467 -
  21.468 -Goal "|- $S2 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)\
  21.469 -\        --> $Enabled (<MClkFwd memCh crCh cst p>_(c p))";
  21.470 -by (auto_tac (MI_css addsimps2 [c_def] addSIs2 [MClkFwd_ch_enabled,MClkFwd_enabled]));
  21.471 -by (cut_facts_tac [MI_base] 1);
  21.472 -by (blast_tac (claset() addDs [base_pair]) 1);
  21.473 -by (ALLGOALS (asm_full_simp_tac (simpset() addsimps [S_def,S2_def])));
  21.474 -qed "S2MClkFwd_enabled";
  21.475 -
  21.476 -Goal "|- [](ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p))\
  21.477 -\        & WF(MClkFwd memCh crCh cst p)_(c p) \
  21.478 -\        --> (S2 rmhist p ~> S3 rmhist p)";
  21.479 -by (REPEAT (resolve_tac [WF1,S2_successors,
  21.480 -                         S2MClkFwd_successors,S2MClkFwd_enabled] 1));
  21.481 -qed "S2_live";
  21.482 -
  21.483 -(* ------------------------------ State S3 ------------------------------ *)
  21.484 -
  21.485 -Goal "|- $S3 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)\
  21.486 -\        --> (S3 rmhist p)$ | (S4 rmhist p | S6 rmhist p)$";
  21.487 -by (split_idle_tac [] 1);
  21.488 -by (auto_tac (MI_css addSDs2 [Step1_2_3]));
  21.489 -qed "S3_successors";
  21.490 -
  21.491 -Goal "|- ($S3 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p))\
  21.492 -\        & <RPCNext crCh rmCh rst p>_(r p) \
  21.493 -\        --> (S4 rmhist p | S6 rmhist p)$";
  21.494 -by (auto_tac (MI_css addsimps2 [angle_def] addSDs2 [Step1_2_3]));
  21.495 -qed "S3RPC_successors";
  21.496 -
  21.497 -Goal "|- $S3 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)\
  21.498 -\        --> $Enabled (<RPCNext crCh rmCh rst p>_(r p))";
  21.499 -by (auto_tac (MI_css addsimps2 [r_def]
  21.500 -                     addSIs2 [RPCFail_Next_enabled,RPCFail_enabled]));
  21.501 -by (cut_facts_tac [MI_base] 1);
  21.502 -by (blast_tac (claset() addDs [base_pair]) 1);
  21.503 -by (ALLGOALS (asm_full_simp_tac (simpset() addsimps [S_def,S3_def])));
  21.504 -qed "S3RPC_enabled";
  21.505 -
  21.506 -Goal "|- [](ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p))\
  21.507 -\        & WF(RPCNext crCh rmCh rst p)_(r p) \
  21.508 -\        --> (S3 rmhist p ~> S4 rmhist p | S6 rmhist p)";
  21.509 -by (REPEAT (resolve_tac [WF1,S3_successors,S3RPC_successors,S3RPC_enabled] 1));
  21.510 -qed "S3_live";
  21.511 -
  21.512 -(* ------------- State S4 -------------------------------------------------- *)
  21.513 -
  21.514 -Goal"|- $S4 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) \
  21.515 -\       & (ALL l. $MemInv mm l)  \
  21.516 -\       --> (S4 rmhist p)$ | (S5 rmhist p)$";
  21.517 -by (split_idle_tac [] 1);
  21.518 -by (auto_tac (MI_css addSDs2 [Step1_2_4]));
  21.519 -qed "S4_successors";
  21.520 -
  21.521 -(* --------- State S4a: S4 /\ (ires p = NotAResult) ------------------------ *)
  21.522 -
  21.523 -Goal "|- $(S4 rmhist p & ires!p = #NotAResult) \
  21.524 -\        & ImpNext p & [HNext rmhist p]_(c p,r p,m p,rmhist!p) & (ALL l. $MemInv mm l)\
  21.525 -\        --> (S4 rmhist p & ires!p = #NotAResult)$  \
  21.526 -\            | ((S4 rmhist p & ires!p ~= #NotAResult) | S5 rmhist p)$";
  21.527 -by (split_idle_tac [m_def] 1);
  21.528 -by (auto_tac (MI_css addSDs2 [Step1_2_4]));
  21.529 -qed "S4a_successors";
  21.530 -
  21.531 -Goal "|- ($(S4 rmhist p & ires!p = #NotAResult)  \
  21.532 -\        & ImpNext p & [HNext rmhist p]_(c p,r p,m p,rmhist!p) & (ALL l. $MemInv mm l))\
  21.533 -\        & <RNext rmCh mm ires p>_(m p) \
  21.534 -\        --> ((S4 rmhist p & ires!p ~= #NotAResult) | S5 rmhist p)$";
  21.535 -by (auto_tac (MI_css addsimps2 [angle_def]
  21.536 -                     addSDs2 [Step1_2_4, ReadResult, WriteResult]));
  21.537 -qed "S4aRNext_successors";
  21.538 -
  21.539 -Goal "|- $(S4 rmhist p & ires!p = #NotAResult) \
  21.540 -\        & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) & (ALL l. $MemInv mm l)\
  21.541 -\        --> $Enabled (<RNext rmCh mm ires p>_(m p))";
  21.542 -by (auto_tac (MI_css addsimps2 [m_def] addSIs2 [RNext_enabled]));
  21.543 -by (cut_facts_tac [MI_base] 1);
  21.544 -by (blast_tac (claset() addDs [base_pair]) 1);
  21.545 -by (asm_full_simp_tac (simpset() addsimps [S_def,S4_def]) 1);
  21.546 -qed "S4aRNext_enabled";
  21.547 -
  21.548 -Goal "|- [](ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)\
  21.549 -\        & (ALL l. $MemInv mm l)) & WF(RNext rmCh mm ires p)_(m p) \
  21.550 -\        --> (S4 rmhist p & ires!p = #NotAResult  \
  21.551 -\             ~> (S4 rmhist p & ires!p ~= #NotAResult) | S5 rmhist p)";
  21.552 -by (REPEAT (resolve_tac [WF1, S4a_successors, S4aRNext_successors, S4aRNext_enabled] 1));
  21.553 -qed "S4a_live";
  21.554 -
  21.555 -(* ---------- State S4b: S4 /\ (ires p # NotAResult) --------------------------- *)
  21.556 -
  21.557 -Goal "|- $(S4 rmhist p & ires!p ~= #NotAResult)  \
  21.558 -\        & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) & (ALL l. $MemInv mm l)\
  21.559 -\        --> (S4 rmhist p & ires!p ~= #NotAResult)$ | (S5 rmhist p)$";
  21.560 -by (split_idle_tac [m_def] 1);
  21.561 -by (auto_tac (MI_css addSDs2 [WriteResult,Step1_2_4,ReadResult]));
  21.562 -qed "S4b_successors";
  21.563 -
  21.564 -Goal "|- ($(S4 rmhist p & ires!p ~= #NotAResult)  \
  21.565 -\        & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) \
  21.566 -\        & (ALL l. $MemInv mm l)) & <MemReturn rmCh ires p>_(m p) \
  21.567 -\        --> (S5 rmhist p)$";
  21.568 -by (force_tac (MI_css addsimps2 [angle_def] addSDs2 [Step1_2_4]
  21.569 -                      addDs2 [ReturnNotReadWrite]) 1);
  21.570 -qed "S4bReturn_successors";
  21.571 -
  21.572 -Goal "|- $(S4 rmhist p & ires!p ~= #NotAResult)  \
  21.573 -\        & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)\
  21.574 -\        & (ALL l. $MemInv mm l)  \
  21.575 -\        --> $Enabled (<MemReturn rmCh ires p>_(m p))";
  21.576 -by (auto_tac (MI_css addsimps2 [m_def] addSIs2 [MemReturn_enabled]));
  21.577 -by (cut_facts_tac [MI_base] 1);
  21.578 -by (blast_tac (claset() addDs [base_pair]) 1);
  21.579 -by (asm_full_simp_tac (simpset() addsimps [S_def,S4_def]) 1);
  21.580 -qed "S4bReturn_enabled";
  21.581 -
  21.582 -Goal "|- [](ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) & (!l. $MemInv mm l)) \
  21.583 -\        & WF(MemReturn rmCh ires p)_(m p) \
  21.584 -\        --> (S4 rmhist p & ires!p ~= #NotAResult ~> S5 rmhist p)";
  21.585 -by (REPEAT (resolve_tac [WF1, S4b_successors,S4bReturn_successors, S4bReturn_enabled] 1));
  21.586 -qed "S4b_live";
  21.587 -
  21.588 -(* ------------------------------ State S5 ------------------------------ *)
  21.589 -
  21.590 -Goal "|- $S5 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) \
  21.591 -\        --> (S5 rmhist p)$ | (S6 rmhist p)$";
  21.592 -by (split_idle_tac [] 1);
  21.593 -by (auto_tac (MI_css addSDs2 [Step1_2_5]));
  21.594 -qed "S5_successors";
  21.595 -
  21.596 -Goal "|- ($S5 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)) \
  21.597 -\        & <RPCNext crCh rmCh rst p>_(r p) \
  21.598 -\        --> (S6 rmhist p)$";
  21.599 -by (auto_tac (MI_css addsimps2 [angle_def] addSDs2 [Step1_2_5]));
  21.600 -qed "S5RPC_successors";
  21.601 -
  21.602 -Goal "|- $S5 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) \
  21.603 -\        --> $Enabled (<RPCNext crCh rmCh rst p>_(r p))";
  21.604 -by (auto_tac (MI_css addsimps2 [r_def]
  21.605 -                     addSIs2 [RPCFail_Next_enabled, RPCFail_enabled]));
  21.606 -by (cut_facts_tac [MI_base] 1);
  21.607 -by (blast_tac (claset() addDs [base_pair]) 1);
  21.608 -by (ALLGOALS (asm_full_simp_tac (simpset() addsimps [S_def,S5_def])));
  21.609 -qed "S5RPC_enabled";
  21.610 -
  21.611 -Goal "|- [](ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p))\
  21.612 -\        & WF(RPCNext crCh rmCh rst p)_(r p) \
  21.613 -\        --> (S5 rmhist p ~> S6 rmhist p)";
  21.614 -by (REPEAT (resolve_tac [WF1,S5_successors,S5RPC_successors,S5RPC_enabled] 1));
  21.615 -qed "S5_live";
  21.616 -
  21.617 -(* ------------------------------ State S6 ------------------------------ *)
  21.618 -
  21.619 -Goal "|- $S6 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) \
  21.620 -\        --> (S1 rmhist p)$ | (S3 rmhist p)$ | (S6 rmhist p)$";
  21.621 -by (split_idle_tac [] 1);
  21.622 -by (auto_tac (MI_css addSDs2 [Step1_2_6]));
  21.623 -qed "S6_successors";
  21.624 -
  21.625 -Goal "|- ($S6 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)) \
  21.626 -\        & <MClkReply memCh crCh cst p>_(c p) \
  21.627 -\        --> (S1 rmhist p)$";
  21.628 -by (auto_tac (MI_css addsimps2 [angle_def] addSDs2 [Step1_2_6, MClkReplyNotRetry]));
  21.629 -qed "S6MClkReply_successors";
  21.630 -
  21.631 -Goal "|- $ImpInv rmhist p & <MClkReply memCh crCh cst p>_(c p) --> $S6 rmhist p";
  21.632 -by (action_simp_tac
  21.633 -      (simpset() addsimps [angle_def,MClkReply_def,Return_def,
  21.634 -                     ImpInv_def,S_def,S1_def,S2_def,S3_def,S4_def,S5_def])
  21.635 -      [] [] 1);
  21.636 -qed "MClkReplyS6";
  21.637 -
  21.638 -Goal "|- S6 rmhist p --> Enabled (<MClkReply memCh crCh cst p>_(c p))";
  21.639 -by (auto_tac (MI_css addsimps2 [c_def] addSIs2 [MClkReply_enabled]));
  21.640 -by (cut_facts_tac [MI_base] 1);
  21.641 -by (blast_tac (claset() addDs [base_pair]) 1);
  21.642 -by (ALLGOALS (action_simp_tac (simpset() addsimps [S_def,S6_def]) [] []));
  21.643 -qed "S6MClkReply_enabled";
  21.644 -
  21.645 -Goal "|- [](ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) & $(ImpInv rmhist p))\
  21.646 -\        & SF(MClkReply memCh crCh cst p)_(c p) & []<>(S6 rmhist p)  \
  21.647 -\        --> []<>(S1 rmhist p)";
  21.648 -by (Clarsimp_tac 1);
  21.649 -by (subgoal_tac "sigma |= []<>(<MClkReply memCh crCh cst p>_(c p))" 1);
  21.650 -by (etac InfiniteEnsures 1);
  21.651 -by (atac 1);
  21.652 -by (action_simp_tac (simpset()) []
  21.653 -                    (map temp_elim [MClkReplyS6,S6MClkReply_successors]) 1);
  21.654 -by (auto_tac (MI_css addsimps2 [SF_def]));
  21.655 -by (etac contrapos_np 1);
  21.656 -by (auto_tac (MI_css addSIs2 [S6MClkReply_enabled] addSEs2 [STL4E, DmdImplE]));
  21.657 -qed "S6_live";
  21.658 -
  21.659 -(* --------------- aggregate leadsto properties----------------------------- *)
  21.660 -
  21.661 -Goal "sigma |= S5 rmhist p ~> S6 rmhist p \
  21.662 -\     ==> sigma |= (S5 rmhist p | S6 rmhist p) ~> S6 rmhist p";
  21.663 -by (auto_tac (MI_css addSIs2 [LatticeDisjunctionIntro, LatticeReflexivity]));
  21.664 -qed "S5S6LeadstoS6";
  21.665 -
  21.666 -Goal "[| sigma |= S4 rmhist p & ires!p ~= #NotAResult ~> S5 rmhist p;\
  21.667 -\        sigma |= S5 rmhist p ~> S6 rmhist p |]  \
  21.668 -\     ==> sigma |= (S4 rmhist p & ires!p ~= #NotAResult) | S5 rmhist p | S6 rmhist p \
  21.669 -\                   ~> S6 rmhist p";
  21.670 -by (auto_tac (MI_css addSIs2 [LatticeDisjunctionIntro,S5S6LeadstoS6]
  21.671 -                     addIs2 [LatticeTransitivity]));
  21.672 -qed "S4bS5S6LeadstoS6";
  21.673 -
  21.674 -Goal "[| sigma |= S4 rmhist p & ires!p = #NotAResult \
  21.675 -\                 ~> (S4 rmhist p & ires!p ~= #NotAResult) | S5 rmhist p; \
  21.676 -\        sigma |= S4 rmhist p & ires!p ~= #NotAResult ~> S5 rmhist p;  \
  21.677 -\        sigma |= S5 rmhist p ~> S6 rmhist p |]  \
  21.678 -\     ==> sigma |= S4 rmhist p | S5 rmhist p | S6 rmhist p ~> S6 rmhist p";
  21.679 -by (subgoal_tac
  21.680 -     "sigma |= (S4 rmhist p & ires!p = #NotAResult)\
  21.681 -\            | (S4 rmhist p & ires!p ~= #NotAResult)\
  21.682 -\            | S5 rmhist p | S6 rmhist p ~> S6 rmhist p" 1);
  21.683 - by (eres_inst_tac
  21.684 -      [("G", "PRED ((S4 rmhist p & ires!p = #NotAResult)\
  21.685 -\                | (S4 rmhist p & ires!p ~= #NotAResult)\
  21.686 -\                | S5 rmhist p | S6 rmhist p)")]
  21.687 -      (temp_use LatticeTransitivity) 1);
  21.688 - by (force_tac (MI_css addsimps2 Init_defs addSIs2 [ImplLeadsto_gen, necT]) 1);
  21.689 -by (rtac (temp_use LatticeDisjunctionIntro) 1);
  21.690 -by (etac (temp_use LatticeTransitivity) 1);
  21.691 -by (etac (temp_use LatticeTriangle2) 1);
  21.692 -by (atac 1);
  21.693 -by (auto_tac (MI_css addSIs2 [S4bS5S6LeadstoS6]));
  21.694 -qed "S4S5S6LeadstoS6";
  21.695 -
  21.696 -Goal "[| sigma |= S3 rmhist p ~> S4 rmhist p | S6 rmhist p;   \
  21.697 -\        sigma |= S4 rmhist p & ires!p = #NotAResult \
  21.698 -\                 ~> (S4 rmhist p & ires!p ~= #NotAResult) | S5 rmhist p; \
  21.699 -\        sigma |= S4 rmhist p & ires!p ~= #NotAResult ~> S5 rmhist p;  \
  21.700 -\        sigma |= S5 rmhist p ~> S6 rmhist p |]  \
  21.701 -\     ==> sigma |= S3 rmhist p | S4 rmhist p | S5 rmhist p | S6 rmhist p ~> S6 rmhist p";
  21.702 -by (rtac (temp_use LatticeDisjunctionIntro) 1);
  21.703 -by (etac (temp_use LatticeTriangle2) 1);
  21.704 -by (rtac (S4S5S6LeadstoS6 RS (temp_use LatticeTransitivity)) 1);
  21.705 -by (auto_tac (MI_css addSIs2 [S4S5S6LeadstoS6,necT]
  21.706 -                     addIs2 [ImplLeadsto_gen] addsimps2 Init_defs));
  21.707 -qed "S3S4S5S6LeadstoS6";
  21.708 -
  21.709 -Goal "[| sigma |= S2 rmhist p ~> S3 rmhist p; \
  21.710 -\        sigma |= S3 rmhist p ~> S4 rmhist p | S6 rmhist p;   \
  21.711 -\        sigma |= S4 rmhist p & ires!p = #NotAResult \
  21.712 -\                 ~> S4 rmhist p & ires!p ~= #NotAResult | S5 rmhist p; \
  21.713 -\        sigma |= S4 rmhist p & ires!p ~= #NotAResult ~> S5 rmhist p;  \
  21.714 -\        sigma |= S5 rmhist p ~> S6 rmhist p |]  \
  21.715 -\     ==> sigma |= S2 rmhist p | S3 rmhist p | S4 rmhist p | S5 rmhist p | S6 rmhist p \
  21.716 -\                  ~> S6 rmhist p";
  21.717 -by (rtac (temp_use LatticeDisjunctionIntro) 1);
  21.718 -by (rtac (temp_use LatticeTransitivity) 1);
  21.719 -by (atac 2);
  21.720 -by (rtac (S3S4S5S6LeadstoS6 RS (temp_use LatticeTransitivity)) 1);
  21.721 -by (auto_tac (MI_css addSIs2 [S3S4S5S6LeadstoS6,necT]
  21.722 -                     addIs2 [ImplLeadsto_gen] addsimps2 Init_defs));
  21.723 -qed "S2S3S4S5S6LeadstoS6";
  21.724 -
  21.725 -Goal "[| sigma |= []ImpInv rmhist p; \
  21.726 -\        sigma |= S2 rmhist p ~> S3 rmhist p; \
  21.727 -\        sigma |= S3 rmhist p ~> S4 rmhist p | S6 rmhist p; \
  21.728 -\        sigma |= S4 rmhist p & ires!p = #NotAResult \
  21.729 -\                 ~> S4 rmhist p & ires!p ~= #NotAResult | S5 rmhist p; \
  21.730 -\        sigma |= S4 rmhist p & ires!p ~= #NotAResult ~> S5 rmhist p;  \
  21.731 -\        sigma |= S5 rmhist p ~> S6 rmhist p |] \
  21.732 -\     ==> sigma |= ~S1 rmhist p ~> S6 rmhist p";
  21.733 -by (rtac (S2S3S4S5S6LeadstoS6 RS (temp_use LatticeTransitivity)) 1);
  21.734 -by (TRYALL atac);
  21.735 -by (etac (temp_use INV_leadsto) 1);
  21.736 -by (rtac (temp_use ImplLeadsto_gen) 1);
  21.737 -by (rtac (temp_use necT) 1);
  21.738 -by (auto_tac (MI_css addsimps2 ImpInv_def::Init_defs addSIs2 [necT]));
  21.739 -qed "NotS1LeadstoS6";
  21.740 -
  21.741 -Goal "[| sigma |= ~S1 rmhist p ~> S6 rmhist p; \
  21.742 -\        sigma |= []<>S6 rmhist p --> []<>S1 rmhist p |] \
  21.743 -\     ==> sigma |= []<>S1 rmhist p";
  21.744 -by (rtac classical 1);
  21.745 -by (asm_lr_simp_tac (simpset() addsimps [temp_use NotBox, NotDmd]) 1);
  21.746 -by (auto_tac (MI_css addSEs2 [mp,leadsto_infinite] addSDs2 [DBImplBD]));
  21.747 -qed "S1Infinite";
  21.748 -
  21.749 -section "Refinement proof (step 1.5)";
  21.750 -
  21.751 -(* Prove invariants of the implementation:
  21.752 -   a. memory invariant
  21.753 -   b. "implementation invariant": always in states S1,...,S6
  21.754 -*)
  21.755 -Goal "|- IPImp p --> (ALL l. []$MemInv mm l)";
  21.756 -by (auto_tac (MI_css addsimps2 [IPImp_def,box_stp_act]
  21.757 -                     addSIs2 [MemoryInvariantAll]));
  21.758 -qed "Step1_5_1a";
  21.759 -
  21.760 -Goal "|- Init(ImpInit p & HInit rmhist p) & [](ImpNext p) \
  21.761 -\        & [][HNext rmhist p]_(c p, r p, m p, rmhist!p) & [](ALL l. $MemInv mm l) \
  21.762 -\        --> []ImpInv rmhist p";
  21.763 -by (inv_tac MI_css 1);
  21.764 -by (auto_tac (MI_css addsimps2 [Init_def, ImpInv_def, box_stp_act]
  21.765 -                     addSDs2 [Step1_1]
  21.766 -                     addDs2 [S1_successors,S2_successors,S3_successors,
  21.767 -                             S4_successors,S5_successors,S6_successors]));
  21.768 -qed "Step1_5_1b";
  21.769 -
  21.770 -(*** Initialization ***)
  21.771 -Goal "|- Init(ImpInit p & HInit rmhist p) --> Init(PInit (resbar rmhist) p)";
  21.772 -by (auto_tac (MI_css addsimps2 [Init_def] addSIs2 [Step1_1,Step1_3]));
  21.773 -qed "Step1_5_2a";
  21.774 -
  21.775 -(*** step simulation ***)
  21.776 -Goal "|- [](ImpNext p & [HNext rmhist p]_(c p, r p, m p, rmhist!p)   \
  21.777 -\        & $ImpInv rmhist p & (!l. $MemInv mm l)) \
  21.778 -\        --> [][UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)";
  21.779 -by (auto_tac (MI_css addsimps2 [ImpInv_def] addSEs2 [STL4E]
  21.780 -                     addSDs2 [S1safe,S2safe,S3safe,S4safe,S5safe,S6safe]));
  21.781 -qed "Step1_5_2b";
  21.782 -
  21.783 -(*** Liveness ***)
  21.784 -Goal "|- IPImp p & HistP rmhist p  \
  21.785 -\        -->   Init(ImpInit p & HInit rmhist p)   \
  21.786 -\            & [](ImpNext p & [HNext rmhist p]_(c p, r p, m p, rmhist!p)) \
  21.787 -\            & [](ALL l. $MemInv mm l) & []($ImpInv rmhist p) \
  21.788 -\            & ImpLive p";
  21.789 -by (Clarsimp_tac 1);
  21.790 -by (subgoal_tac
  21.791 -      "sigma |= Init(ImpInit p & HInit rmhist p) \
  21.792 -\             & [](ImpNext p) \
  21.793 -\             & [][HNext rmhist p]_(c p, r p, m p, rmhist!p) \
  21.794 -\             & [](ALL l. $MemInv mm l)" 1);
  21.795 -by (auto_tac (MI_css addsimps2 [split_box_conj,box_stp_act] addSDs2 [Step1_5_1b]));
  21.796 -by (force_tac (MI_css addsimps2 [IPImp_def,MClkIPSpec_def,RPCIPSpec_def,RPSpec_def,
  21.797 -                                 ImpLive_def,c_def,r_def,m_def]) 1);
  21.798 -by (force_tac (MI_css addsimps2 [IPImp_def,MClkIPSpec_def,RPCIPSpec_def,RPSpec_def,
  21.799 -                                 HistP_def,Init_def,ImpInit_def]) 1);
  21.800 -by (force_tac (MI_css addsimps2 [IPImp_def,MClkIPSpec_def,RPCIPSpec_def,RPSpec_def,
  21.801 -                                 ImpNext_def,c_def,r_def,m_def,split_box_conj]) 1);
  21.802 -by (force_tac (MI_css addsimps2 [HistP_def]) 1);
  21.803 -by (force_tac (MI_css addsimps2 [temp_use allT] addSDs2 [Step1_5_1a]) 1);
  21.804 -qed "GoodImpl";
  21.805 -
  21.806 -(* The implementation is infinitely often in state S1... *)
  21.807 -Goal "|- [](ImpNext p & [HNext rmhist p]_(c p, r p, m p, rmhist!p)) \
  21.808 -\        & [](ALL l. $MemInv mm l)  \
  21.809 -\        & []($ImpInv rmhist p) & ImpLive p  \
  21.810 -\        --> []<>S1 rmhist p";
  21.811 -by (clarsimp_tac (MI_css addsimps2 [ImpLive_def]) 1);
  21.812 -by (rtac S1Infinite 1);
  21.813 -by (force_tac
  21.814 -      (MI_css addsimps2 [split_box_conj,box_stp_act]
  21.815 -              addSIs2 [NotS1LeadstoS6,S2_live,S3_live,S4a_live,S4b_live,S5_live]) 1);
  21.816 -by (auto_tac (MI_css addsimps2 [split_box_conj] addSIs2 [S6_live]));
  21.817 -qed "Step1_5_3a";
  21.818 -
  21.819 -(* ... and therefore satisfies the fairness requirements of the specification *)
  21.820 -Goal "|- [](ImpNext p & [HNext rmhist p]_(c p, r p, m p, rmhist!p)) \
  21.821 -\        & [](ALL l. $MemInv mm l) & []($ImpInv rmhist p) & ImpLive p  \
  21.822 -\        --> WF(RNext memCh mm (resbar rmhist) p)_(rtrner memCh!p, resbar rmhist!p)";
  21.823 -by (auto_tac (MI_css addSIs2 [RNext_fair,Step1_5_3a]));
  21.824 -qed "Step1_5_3b";
  21.825 -
  21.826 -Goal "|- [](ImpNext p & [HNext rmhist p]_(c p, r p, m p, rmhist!p)) \
  21.827 -\        & [](ALL l. $MemInv mm l) & []($ImpInv rmhist p) & ImpLive p  \
  21.828 -\        --> WF(MemReturn memCh (resbar rmhist) p)_(rtrner memCh!p, resbar rmhist!p)";
  21.829 -by (auto_tac (MI_css addSIs2 [Return_fair,Step1_5_3a]));
  21.830 -qed "Step1_5_3c";
  21.831 -
  21.832 -(* QED step of step 1 *)
  21.833 -Goal "|- IPImp p & HistP rmhist p --> UPSpec memCh mm (resbar rmhist) p";
  21.834 -by (auto_tac (MI_css addsimps2 [UPSpec_def,split_box_conj]
  21.835 -                     addSDs2 [GoodImpl]
  21.836 -                     addSIs2 [Step1_5_2a,Step1_5_2b,Step1_5_3b,Step1_5_3c]));
  21.837 -qed "Step1";
  21.838 -
  21.839 -(* ------------------------------ Step 2 ------------------------------ *)
  21.840 -section "Step 2";
  21.841 -
  21.842 -Goal "|- Write rmCh mm ires p l & ImpNext p\
  21.843 -\        & [HNext rmhist p]_(c p, r p, m p, rmhist!p) \
  21.844 -\        & $ImpInv rmhist p  \
  21.845 -\        --> (S4 rmhist p)$ & unchanged (e p, c p, r p, rmhist!p)";
  21.846 -by (Clarsimp_tac 1);
  21.847 -by (dtac (action_use WriteS4) 1);
  21.848 -by (atac 1);
  21.849 -by (split_idle_tac [] 1);
  21.850 -by (auto_tac (MI_css addsimps2 [ImpNext_def]
  21.851 -                     addSDs2 [S4EnvUnch,S4ClerkUnch,S4RPCUnch]));
  21.852 -by (auto_tac (MI_css addsimps2 [square_def] addDs2 [S4Write]));
  21.853 -qed "Step2_2a";
  21.854 -
  21.855 -Goal "|-   (ALL p. ImpNext p) \
  21.856 -\        & (ALL p. [HNext rmhist p]_(c p, r p, m p, rmhist!p)) \
  21.857 -\        & (ALL p. $ImpInv rmhist p) \
  21.858 -\        & [EX q. Write rmCh mm ires q l]_(mm!l) \
  21.859 -\        --> [EX q. Write memCh mm (resbar rmhist) q l]_(mm!l)";
  21.860 -by (auto_tac (MI_css addSIs2 [squareCI] addSEs2 [squareE]));
  21.861 -by (REPEAT (ares_tac [exI, action_use Step1_4_4b] 1));
  21.862 -by (force_tac (MI_css addSIs2 [WriteS4]) 1);
  21.863 -by (auto_tac (MI_css addSDs2 [Step2_2a]));
  21.864 -qed "Step2_2";
  21.865 -
  21.866 -Goal "|- [](  (ALL p. ImpNext p) \
  21.867 -\           & (ALL p. [HNext rmhist p]_(c p, r p, m p, rmhist!p)) \
  21.868 -\           & (ALL p. $ImpInv rmhist p) \
  21.869 -\           & [EX q. Write rmCh mm ires q l]_(mm!l)) \
  21.870 -\        --> [][EX q. Write memCh mm (resbar rmhist) q l]_(mm!l)";
  21.871 -by (force_tac (MI_css addSEs2 [STL4E] addSDs2 [Step2_2]) 1);
  21.872 -qed "Step2_lemma";
  21.873 -
  21.874 -Goal "|- #l : #MemLoc & (ALL p. IPImp p & HistP rmhist p)  \
  21.875 -\        --> MSpec memCh mm (resbar rmhist) l";
  21.876 -by (auto_tac (MI_css addsimps2 [MSpec_def]));
  21.877 -by (force_tac (MI_css addsimps2 [IPImp_def,MSpec_def]) 1);
  21.878 -by (auto_tac (MI_css addSIs2 [Step2_lemma]
  21.879 -                     addsimps2 [split_box_conj,all_box]));
  21.880 -by (force_tac (MI_css addsimps2 [IPImp_def,MSpec_def]) 4);
  21.881 -by (auto_tac (MI_css addsimps2 [split_box_conj] addSEs2 [allE] addSDs2 [GoodImpl]));
  21.882 -qed "Step2";
  21.883 -
  21.884 -(* ----------------------------- Main theorem --------------------------------- *)
  21.885 -section "Memory implementation";
  21.886 -
  21.887 -(* The combination of a legal caller, the memory clerk, the RPC component,
  21.888 -   and a reliable memory implement the unreliable memory.
  21.889 -*)
  21.890 -
  21.891 -(* Implementation of internal specification by combination of implementation
  21.892 -   and history variable with explicit refinement mapping
  21.893 -*)
  21.894 -Goal "|- Implementation & Hist rmhist --> IUSpec memCh mm (resbar rmhist)";
  21.895 -by (auto_tac (MI_css addsimps2 [IUSpec_def,Implementation_def,IPImp_def,
  21.896 -                                MClkISpec_def,RPCISpec_def,IRSpec_def,Hist_def]
  21.897 -                     addSIs2 [Step1,Step2]));
  21.898 -qed "Impl_IUSpec";
  21.899 -
  21.900 -(* The main theorem: introduce hiding and eliminate history variable. *)
  21.901 -Goal "|- Implementation --> USpec memCh";
  21.902 -by (Clarsimp_tac 1);
  21.903 -by (forward_tac [temp_use History] 1);
  21.904 -by (auto_tac (MI_css addsimps2 [USpec_def]
  21.905 -                     addIs2 [eexI, Impl_IUSpec, MI_base]
  21.906 -                     addSEs2 [eexE]));
  21.907 -qed "Implementation";
    22.1 --- a/src/HOL/TLA/Memory/MemoryImplementation.thy	Fri Dec 01 17:22:33 2006 +0100
    22.2 +++ b/src/HOL/TLA/Memory/MemoryImplementation.thy	Sat Dec 02 02:52:02 2006 +0100
    22.3 @@ -3,12 +3,9 @@
    22.4      ID:          $Id$
    22.5      Author:      Stephan Merz
    22.6      Copyright:   1997 University of Munich
    22.7 +*)
    22.8  
    22.9 -    Theory Name: MemoryImplementation
   22.10 -    Logic Image: TLA
   22.11 -
   22.12 -    RPC-Memory example: Memory implementation
   22.13 -*)
   22.14 +header {* RPC-Memory example: Memory implementation *}
   22.15  
   22.16  theory MemoryImplementation
   22.17  imports Memory RPC MemClerk
   22.18 @@ -177,6 +174,1143 @@
   22.19                             (rtrner crCh!p, caller rmCh!p, rst!p),
   22.20                             (mm!l, rtrner rmCh!p, ires!p))"
   22.21  
   22.22 -ML {* use_legacy_bindings (the_context ()) *}
   22.23 +(*
   22.24 +    The main theorem is theorem "Implementation" at the end of this file,
   22.25 +    which shows that the composition of a reliable memory, an RPC component, and
   22.26 +    a memory clerk implements an unreliable memory. The files "MIsafe.ML" and
   22.27 +    "MIlive.ML" contain lower-level lemmas for the safety and liveness parts.
   22.28 +
   22.29 +    Steps are (roughly) numbered as in the hand proof.
   22.30 +*)
   22.31 +
   22.32 +(* --------------------------- automatic prover --------------------------- *)
   22.33 +
   22.34 +declare if_weak_cong [cong del]
   22.35 +
   22.36 +ML {* val MI_css = (claset(), simpset()) *}
   22.37 +
   22.38 +(* A more aggressive variant that tries to solve subgoals by assumption
   22.39 +   or contradiction during the simplification.
   22.40 +   THIS IS UNSAFE, BECAUSE IT DOESN'T RECORD THE CHOICES!!
   22.41 +   (but it can be a lot faster than MI_css)
   22.42 +*)
   22.43 +
   22.44 +ML {*
   22.45 +val MI_fast_css =
   22.46 +  let
   22.47 +    val (cs,ss) = MI_css
   22.48 +  in
   22.49 +    (cs addSEs [temp_use (thm "squareE")],
   22.50 +      ss addSSolver (mk_solver "" (fn thms => assume_tac ORELSE' (etac notE))))
   22.51 +  end;
   22.52 +
   22.53 +val temp_elim = make_elim o temp_use;
   22.54 +*}
   22.55 +
   22.56 +
   22.57 +
   22.58 +(****************************** The history variable ******************************)
   22.59 +
   22.60 +section "History variable"
   22.61 +
   22.62 +lemma HistoryLemma: "|- Init(ALL p. ImpInit p) & [](ALL p. ImpNext p)
   22.63 +         --> (EEX rmhist. Init(ALL p. HInit rmhist p)
   22.64 +                          & [](ALL p. [HNext rmhist p]_(c p, r p, m p, rmhist!p)))"
   22.65 +  apply clarsimp
   22.66 +  apply (rule historyI)
   22.67 +      apply assumption+
   22.68 +  apply (rule MI_base)
   22.69 +  apply (tactic {* action_simp_tac (simpset () addsimps [thm "HInit_def"]) [] [] 1 *})
   22.70 +   apply (erule fun_cong)
   22.71 +  apply (tactic {* action_simp_tac (simpset () addsimps [thm "HNext_def"])
   22.72 +    [thm "busy_squareI"] [] 1 *})
   22.73 +  apply (erule fun_cong)
   22.74 +  done
   22.75 +
   22.76 +lemma History: "|- Implementation --> (EEX rmhist. Hist rmhist)"
   22.77 +  apply clarsimp
   22.78 +  apply (rule HistoryLemma [temp_use, THEN eex_mono])
   22.79 +    prefer 3
   22.80 +    apply (force simp: Hist_def HistP_def Init_def all_box [try_rewrite]
   22.81 +      split_box_conj [try_rewrite])
   22.82 +   apply (auto simp: Implementation_def MClkISpec_def RPCISpec_def
   22.83 +     IRSpec_def MClkIPSpec_def RPCIPSpec_def RPSpec_def ImpInit_def
   22.84 +     Init_def ImpNext_def c_def r_def m_def all_box [temp_use] split_box_conj [temp_use])
   22.85 +  done
   22.86 +
   22.87 +(******************************** The safety part *********************************)
   22.88 +
   22.89 +section "The safety part"
   22.90 +
   22.91 +(* ------------------------- Include lower-level lemmas ------------------------- *)
   22.92 +
   22.93 +(* RPCFailure notin MemVals U {OK,BadArg} *)
   22.94 +
   22.95 +lemma MVOKBAnotRF: "MVOKBA x ==> x ~= RPCFailure"
   22.96 +  apply (unfold MVOKBA_def)
   22.97 +  apply auto
   22.98 +  done
   22.99 +
  22.100 +(* NotAResult notin MemVals U {OK,BadArg,RPCFailure} *)
  22.101 +
  22.102 +lemma MVOKBARFnotNR: "MVOKBARF x ==> x ~= NotAResult"
  22.103 +  apply (unfold MVOKBARF_def)
  22.104 +  apply auto
  22.105 +  done
  22.106 +
  22.107 +(* ================ Si's are mutually exclusive ================================ *)
  22.108 +(* Si and Sj are mutually exclusive for i # j. This helps to simplify the big
  22.109 +   conditional in the definition of resbar when doing the step-simulation proof.
  22.110 +   We prove a weaker result, which suffices for our purposes:
  22.111 +   Si implies (not Sj), for j<i.
  22.112 +*)
  22.113 +
  22.114 +(* --- not used ---
  22.115 +Goal "|- S1 rmhist p --> S1 rmhist p & ~S2 rmhist p & ~S3 rmhist p &
  22.116 +                         ~S4 rmhist p & ~S5 rmhist p & ~S6 rmhist p"
  22.117 +by (auto_tac (MI_css addsimps2 [S_def, S1_def, S2_def,
  22.118 +                                S3_def, S4_def, S5_def, S6_def]));
  22.119 +qed "S1_excl";
  22.120 +*)
  22.121 +
  22.122 +lemma S2_excl: "|- S2 rmhist p --> S2 rmhist p & ~S1 rmhist p"
  22.123 +  by (auto simp: S_def S1_def S2_def)
  22.124 +
  22.125 +lemma S3_excl: "|- S3 rmhist p --> S3 rmhist p & ~S1 rmhist p & ~S2 rmhist p"
  22.126 +  by (auto simp: S_def S1_def S2_def S3_def)
  22.127 +
  22.128 +lemma S4_excl: "|- S4 rmhist p --> S4 rmhist p & ~S1 rmhist p & ~S2 rmhist p & ~S3 rmhist p"
  22.129 +  by (auto simp: S_def S1_def S2_def S3_def S4_def)
  22.130 +
  22.131 +lemma S5_excl: "|- S5 rmhist p --> S5 rmhist p & ~S1 rmhist p & ~S2 rmhist p
  22.132 +                         & ~S3 rmhist p & ~S4 rmhist p"
  22.133 +  by (auto simp: S_def S1_def S2_def S3_def S4_def S5_def)
  22.134 +
  22.135 +lemma S6_excl: "|- S6 rmhist p --> S6 rmhist p & ~S1 rmhist p & ~S2 rmhist p
  22.136 +                         & ~S3 rmhist p & ~S4 rmhist p & ~S5 rmhist p"
  22.137 +  by (auto simp: S_def S1_def S2_def S3_def S4_def S5_def S6_def)
  22.138 +
  22.139 +
  22.140 +(* ==================== Lemmas about the environment ============================== *)
  22.141 +
  22.142 +lemma Envbusy: "|- $(Calling memCh p) --> ~ENext p"
  22.143 +  by (auto simp: ENext_def Call_def)
  22.144 +
  22.145 +(* ==================== Lemmas about the implementation's states ==================== *)
  22.146 +
  22.147 +(* The following series of lemmas are used in establishing the implementation's
  22.148 +   next-state relation (Step 1.2 of the proof in the paper). For each state Si, we
  22.149 +   determine which component actions are possible and what state they result in.
  22.150 +*)
  22.151 +
  22.152 +(* ------------------------------ State S1 ---------------------------------------- *)
  22.153 +
  22.154 +lemma S1Env: "|- ENext p & $(S1 rmhist p) & unchanged (c p, r p, m p, rmhist!p)
  22.155 +         --> (S2 rmhist p)$"
  22.156 +  by (force simp: ENext_def Call_def c_def r_def m_def
  22.157 +    caller_def rtrner_def MVNROKBA_def S_def S1_def S2_def Calling_def)
  22.158 +
  22.159 +lemma S1ClerkUnch: "|- [MClkNext memCh crCh cst p]_(c p) & $(S1 rmhist p) --> unchanged (c p)"
  22.160 +  by (tactic {* auto_tac (MI_fast_css addSDs2 [temp_use (thm "MClkidle")]
  22.161 +    addsimps2 [thm "S_def", thm "S1_def"]) *})
  22.162 +
  22.163 +lemma S1RPCUnch: "|- [RPCNext crCh rmCh rst p]_(r p) & $(S1 rmhist p) --> unchanged (r p)"
  22.164 +  by (tactic {* auto_tac (MI_fast_css addSDs2 [temp_use (thm "RPCidle")]
  22.165 +    addsimps2 [thm "S_def", thm "S1_def"]) *})
  22.166 +
  22.167 +lemma S1MemUnch: "|- [RNext rmCh mm ires p]_(m p) & $(S1 rmhist p) --> unchanged (m p)"
  22.168 +  by (tactic {* auto_tac (MI_fast_css addSDs2 [temp_use (thm "Memoryidle")]
  22.169 +    addsimps2 [thm "S_def", thm "S1_def"]) *})
  22.170 +
  22.171 +lemma S1Hist: "|- [HNext rmhist p]_(c p,r p,m p,rmhist!p) & $(S1 rmhist p)
  22.172 +         --> unchanged (rmhist!p)"
  22.173 +  by (tactic {* action_simp_tac (simpset () addsimps [thm "HNext_def", thm "S_def",
  22.174 +    thm "S1_def", thm "MemReturn_def", thm "RPCFail_def", thm "MClkReply_def",
  22.175 +    thm "Return_def"]) [] [temp_use (thm "squareE")] 1 *})
  22.176 +
  22.177 +
  22.178 +(* ------------------------------ State S2 ---------------------------------------- *)
  22.179 +
  22.180 +lemma S2EnvUnch: "|- [ENext p]_(e p) & $(S2 rmhist p) --> unchanged (e p)"
  22.181 +  by (auto dest!: Envbusy [temp_use] simp: S_def S2_def)
  22.182 +
  22.183 +lemma S2Clerk: "|- MClkNext memCh crCh cst p & $(S2 rmhist p) --> MClkFwd memCh crCh cst p"
  22.184 +  by (auto simp: MClkNext_def MClkRetry_def MClkReply_def S_def S2_def)
  22.185 +
  22.186 +lemma S2Forward: "|- $(S2 rmhist p) & MClkFwd memCh crCh cst p
  22.187 +         & unchanged (e p, r p, m p, rmhist!p)
  22.188 +         --> (S3 rmhist p)$"
  22.189 +  by (tactic {* action_simp_tac (simpset () addsimps [thm "MClkFwd_def",
  22.190 +    thm "Call_def", thm "e_def", thm "r_def", thm "m_def", thm "caller_def",
  22.191 +    thm "rtrner_def", thm "S_def", thm "S2_def", thm "S3_def", thm "Calling_def"]) [] [] 1 *})
  22.192 +
  22.193 +lemma S2RPCUnch: "|- [RPCNext crCh rmCh rst p]_(r p) & $(S2 rmhist p) --> unchanged (r p)"
  22.194 +  by (auto simp: S_def S2_def dest!: RPCidle [temp_use])
  22.195 +
  22.196 +lemma S2MemUnch: "|- [RNext rmCh mm ires p]_(m p) & $(S2 rmhist p) --> unchanged (m p)"
  22.197 +  by (auto simp: S_def S2_def dest!: Memoryidle [temp_use])
  22.198 +
  22.199 +lemma S2Hist: "|- [HNext rmhist p]_(c p,r p,m p,rmhist!p) & $(S2 rmhist p)
  22.200 +         --> unchanged (rmhist!p)"
  22.201 +  by (tactic {* auto_tac (MI_fast_css addsimps2 [thm "HNext_def", thm "MemReturn_def",
  22.202 +    thm "RPCFail_def", thm "MClkReply_def", thm "Return_def", thm "S_def", thm "S2_def"]) *})
  22.203 +
  22.204 +(* ------------------------------ State S3 ---------------------------------------- *)
  22.205 +
  22.206 +lemma S3EnvUnch: "|- [ENext p]_(e p) & $(S3 rmhist p) --> unchanged (e p)"
  22.207 +  by (auto dest!: Envbusy [temp_use] simp: S_def S3_def)
  22.208 +
  22.209 +lemma S3ClerkUnch: "|- [MClkNext memCh crCh cst p]_(c p) & $(S3 rmhist p) --> unchanged (c p)"
  22.210 +  by (auto dest!: MClkbusy [temp_use] simp: square_def S_def S3_def)
  22.211 +
  22.212 +lemma S3LegalRcvArg: "|- S3 rmhist p --> IsLegalRcvArg<arg<crCh!p>>"
  22.213 +  by (auto simp: IsLegalRcvArg_def MClkRelayArg_def S_def S3_def)
  22.214 +
  22.215 +lemma S3RPC: "|- RPCNext crCh rmCh rst p & $(S3 rmhist p)
  22.216 +         --> RPCFwd crCh rmCh rst p | RPCFail crCh rmCh rst p"
  22.217 +  apply clarsimp
  22.218 +  apply (frule S3LegalRcvArg [action_use])
  22.219 +  apply (auto simp: RPCNext_def RPCReject_def RPCReply_def S_def S3_def)
  22.220 +  done
  22.221 +
  22.222 +lemma S3Forward: "|- RPCFwd crCh rmCh rst p & HNext rmhist p & $(S3 rmhist p)
  22.223 +         & unchanged (e p, c p, m p)
  22.224 +         --> (S4 rmhist p)$ & unchanged (rmhist!p)"
  22.225 +  by (tactic {* action_simp_tac (simpset () addsimps [thm "RPCFwd_def",
  22.226 +    thm "HNext_def", thm "MemReturn_def", thm "RPCFail_def",
  22.227 +    thm "MClkReply_def", thm "Return_def", thm "Call_def", thm "e_def",
  22.228 +    thm "c_def", thm "m_def", thm "caller_def", thm "rtrner_def", thm "S_def",
  22.229 +    thm "S3_def", thm "S4_def", thm "Calling_def"]) [] [] 1 *})
  22.230 +
  22.231 +lemma S3Fail: "|- RPCFail crCh rmCh rst p & $(S3 rmhist p) & HNext rmhist p
  22.232 +         & unchanged (e p, c p, m p)
  22.233 +         --> (S6 rmhist p)$"
  22.234 +  by (tactic {* action_simp_tac (simpset () addsimps [thm "HNext_def",
  22.235 +    thm "RPCFail_def", thm "Return_def", thm "e_def", thm "c_def",
  22.236 +    thm "m_def", thm "caller_def", thm "rtrner_def", thm "MVOKBARF_def",
  22.237 +    thm "S_def", thm "S3_def", thm "S6_def", thm "Calling_def"]) [] [] 1 *})
  22.238 +
  22.239 +lemma S3MemUnch: "|- [RNext rmCh mm ires p]_(m p) & $(S3 rmhist p) --> unchanged (m p)"
  22.240 +  by (auto simp: S_def S3_def dest!: Memoryidle [temp_use])
  22.241 +
  22.242 +lemma S3Hist: "|- HNext rmhist p & $(S3 rmhist p) & unchanged (r p) --> unchanged (rmhist!p)"
  22.243 +  by (auto simp: HNext_def MemReturn_def RPCFail_def MClkReply_def
  22.244 +    Return_def r_def rtrner_def S_def S3_def Calling_def)
  22.245 +
  22.246 +(* ------------------------------ State S4 ---------------------------------------- *)
  22.247 +
  22.248 +lemma S4EnvUnch: "|- [ENext p]_(e p) & $(S4 rmhist p) --> unchanged (e p)"
  22.249 +  by (auto simp: S_def S4_def dest!: Envbusy [temp_use])
  22.250 +
  22.251 +lemma S4ClerkUnch: "|- [MClkNext memCh crCh cst p]_(c p) & $(S4 rmhist p) --> unchanged (c p)"
  22.252 +  by (auto simp: S_def S4_def dest!: MClkbusy [temp_use])
  22.253 +
  22.254 +lemma S4RPCUnch: "|- [RPCNext crCh rmCh rst p]_(r p) & $(S4 rmhist p) --> unchanged (r p)"
  22.255 +  by (tactic {* auto_tac (MI_fast_css addsimps2 [thm "S_def", thm "S4_def"]
  22.256 +    addSDs2 [temp_use (thm "RPCbusy")]) *})
  22.257 +
  22.258 +lemma S4ReadInner: "|- ReadInner rmCh mm ires p l & $(S4 rmhist p) & unchanged (e p, c p, r p)
  22.259 +         & HNext rmhist p & $(MemInv mm l)
  22.260 +         --> (S4 rmhist p)$ & unchanged (rmhist!p)"
  22.261 +  by (tactic {* action_simp_tac (simpset () addsimps [thm "ReadInner_def",
  22.262 +    thm "GoodRead_def", thm "BadRead_def", thm "HNext_def", thm "MemReturn_def",
  22.263 +    thm "RPCFail_def", thm "MClkReply_def", thm "Return_def", thm "e_def",
  22.264 +    thm "c_def", thm "r_def", thm "rtrner_def", thm "caller_def",
  22.265 +    thm "MVNROKBA_def", thm "S_def", thm "S4_def", thm "RdRequest_def",
  22.266 +    thm "Calling_def", thm "MemInv_def"]) [] [] 1 *})
  22.267 +
  22.268 +lemma S4Read: "|- Read rmCh mm ires p & $(S4 rmhist p) & unchanged (e p, c p, r p)
  22.269 +         & HNext rmhist p & (!l. $MemInv mm l)
  22.270 +         --> (S4 rmhist p)$ & unchanged (rmhist!p)"
  22.271 +  by (auto simp: Read_def dest!: S4ReadInner [temp_use])
  22.272 +
  22.273 +lemma S4WriteInner: "|- WriteInner rmCh mm ires p l v & $(S4 rmhist p) & unchanged (e p, c p, r p)           & HNext rmhist p
  22.274 +         --> (S4 rmhist p)$ & unchanged (rmhist!p)"
  22.275 +  by (tactic {* action_simp_tac (simpset () addsimps [thm "WriteInner_def",
  22.276 +    thm "GoodWrite_def", thm "BadWrite_def", thm "HNext_def", thm "MemReturn_def",
  22.277 +    thm "RPCFail_def", thm "MClkReply_def", thm "Return_def", thm "e_def",
  22.278 +    thm "c_def", thm "r_def", thm "rtrner_def", thm "caller_def", thm "MVNROKBA_def",
  22.279 +    thm "S_def", thm "S4_def", thm "WrRequest_def", thm "Calling_def"]) [] [] 1 *})
  22.280 +
  22.281 +lemma S4Write: "|- Write rmCh mm ires p l & $(S4 rmhist p) & unchanged (e p, c p, r p)
  22.282 +         & (HNext rmhist p)
  22.283 +         --> (S4 rmhist p)$ & unchanged (rmhist!p)"
  22.284 +  by (auto simp: Write_def dest!: S4WriteInner [temp_use])
  22.285 +
  22.286 +lemma WriteS4: "|- $ImpInv rmhist p & Write rmCh mm ires p l --> $S4 rmhist p"
  22.287 +  by (auto simp: Write_def WriteInner_def ImpInv_def
  22.288 +    WrRequest_def S_def S1_def S2_def S3_def S4_def S5_def S6_def)
  22.289 +
  22.290 +lemma S4Return: "|- MemReturn rmCh ires p & $S4 rmhist p & unchanged (e p, c p, r p)
  22.291 +         & HNext rmhist p
  22.292 +         --> (S5 rmhist p)$"
  22.293 +  by (auto simp: HNext_def MemReturn_def Return_def e_def c_def r_def
  22.294 +    rtrner_def caller_def MVNROKBA_def MVOKBA_def S_def S4_def S5_def Calling_def)
  22.295 +
  22.296 +lemma S4Hist: "|- HNext rmhist p & $S4 rmhist p & (m p)$ = $(m p) --> (rmhist!p)$ = $(rmhist!p)"
  22.297 +  by (auto simp: HNext_def MemReturn_def RPCFail_def MClkReply_def
  22.298 +    Return_def m_def rtrner_def S_def S4_def Calling_def)
  22.299 +
  22.300 +(* ------------------------------ State S5 ---------------------------------------- *)
  22.301 +
  22.302 +lemma S5EnvUnch: "|- [ENext p]_(e p) & $(S5 rmhist p) --> unchanged (e p)"
  22.303 +  by (auto simp: S_def S5_def dest!: Envbusy [temp_use])
  22.304 +
  22.305 +lemma S5ClerkUnch: "|- [MClkNext memCh crCh cst p]_(c p) & $(S5 rmhist p) --> unchanged (c p)"
  22.306 +  by (auto simp: S_def S5_def dest!: MClkbusy [temp_use])
  22.307 +
  22.308 +lemma S5RPC: "|- RPCNext crCh rmCh rst p & $(S5 rmhist p)
  22.309 +         --> RPCReply crCh rmCh rst p | RPCFail crCh rmCh rst p"
  22.310 +  by (auto simp: RPCNext_def RPCReject_def RPCFwd_def S_def S5_def)
  22.311 +
  22.312 +lemma S5Reply: "|- RPCReply crCh rmCh rst p & $(S5 rmhist p) & unchanged (e p, c p, m p,rmhist!p)
  22.313 +       --> (S6 rmhist p)$"
  22.314 +  by (tactic {* action_simp_tac (simpset () addsimps [thm "RPCReply_def",
  22.315 +    thm "Return_def", thm "e_def", thm "c_def", thm "m_def", thm "MVOKBA_def",
  22.316 +    thm "MVOKBARF_def", thm "caller_def", thm "rtrner_def", thm "S_def",
  22.317 +    thm "S5_def", thm "S6_def", thm "Calling_def"]) [] [] 1 *})
  22.318 +
  22.319 +lemma S5Fail: "|- RPCFail crCh rmCh rst p & $(S5 rmhist p) & unchanged (e p, c p, m p,rmhist!p)
  22.320 +         --> (S6 rmhist p)$"
  22.321 +  by (tactic {* action_simp_tac (simpset () addsimps [thm "RPCFail_def",
  22.322 +    thm "Return_def", thm "e_def", thm "c_def", thm "m_def",
  22.323 +    thm "MVOKBARF_def", thm "caller_def", thm "rtrner_def",
  22.324 +    thm "S_def", thm "S5_def", thm "S6_def", thm "Calling_def"]) [] [] 1 *})
  22.325 +
  22.326 +lemma S5MemUnch: "|- [RNext rmCh mm ires p]_(m p) & $(S5 rmhist p) --> unchanged (m p)"
  22.327 +  by (auto simp: S_def S5_def dest!: Memoryidle [temp_use])
  22.328 +
  22.329 +lemma S5Hist: "|- [HNext rmhist p]_(c p, r p, m p, rmhist!p) & $(S5 rmhist p)
  22.330 +         --> (rmhist!p)$ = $(rmhist!p)"
  22.331 +  by (tactic {* auto_tac (MI_fast_css addsimps2 [thm "HNext_def",
  22.332 +    thm "MemReturn_def", thm "RPCFail_def", thm "MClkReply_def", thm "Return_def",
  22.333 +    thm "S_def", thm "S5_def"]) *})
  22.334 +
  22.335 +(* ------------------------------ State S6 ---------------------------------------- *)
  22.336 +
  22.337 +lemma S6EnvUnch: "|- [ENext p]_(e p) & $(S6 rmhist p) --> unchanged (e p)"
  22.338 +  by (auto simp: S_def S6_def dest!: Envbusy [temp_use])
  22.339 +
  22.340 +lemma S6Clerk: "|- MClkNext memCh crCh cst p & $(S6 rmhist p)
  22.341 +         --> MClkRetry memCh crCh cst p | MClkReply memCh crCh cst p"
  22.342 +  by (auto simp: MClkNext_def MClkFwd_def S_def S6_def)
  22.343 +
  22.344 +lemma S6Retry: "|- MClkRetry memCh crCh cst p & HNext rmhist p & $S6 rmhist p
  22.345 +         & unchanged (e p,r p,m p)
  22.346 +         --> (S3 rmhist p)$ & unchanged (rmhist!p)"
  22.347 +  by (tactic {* action_simp_tac (simpset () addsimps [thm "HNext_def",
  22.348 +    thm "MClkReply_def", thm "MClkRetry_def", thm "Call_def", thm "Return_def",
  22.349 +    thm "e_def", thm "r_def", thm "m_def", thm "caller_def", thm "rtrner_def",
  22.350 +    thm "S_def", thm "S6_def", thm "S3_def", thm "Calling_def"]) [] [] 1 *})
  22.351 +
  22.352 +lemma S6Reply: "|- MClkReply memCh crCh cst p & HNext rmhist p & $S6 rmhist p
  22.353 +         & unchanged (e p,r p,m p)
  22.354 +         --> (S1 rmhist p)$"
  22.355 +  by (tactic {* action_simp_tac (simpset () addsimps [thm "HNext_def",
  22.356 +    thm "MemReturn_def", thm "RPCFail_def", thm "Return_def", thm "MClkReply_def",
  22.357 +    thm "e_def", thm "r_def", thm "m_def", thm "caller_def", thm "rtrner_def",
  22.358 +    thm "S_def", thm "S6_def", thm "S1_def", thm "Calling_def"]) [] [] 1 *})
  22.359 +
  22.360 +lemma S6RPCUnch: "|- [RPCNext crCh rmCh rst p]_(r p) & $S6 rmhist p --> unchanged (r p)"
  22.361 +  by (auto simp: S_def S6_def dest!: RPCidle [temp_use])
  22.362 +
  22.363 +lemma S6MemUnch: "|- [RNext rmCh mm ires p]_(m p) & $(S6 rmhist p) --> unchanged (m p)"
  22.364 +  by (auto simp: S_def S6_def dest!: Memoryidle [temp_use])
  22.365 +
  22.366 +lemma S6Hist: "|- HNext rmhist p & $S6 rmhist p & (c p)$ = $(c p) --> (rmhist!p)$ = $(rmhist!p)"
  22.367 +  by (auto simp: HNext_def MClkReply_def Return_def c_def rtrner_def S_def S6_def Calling_def)
  22.368 +
  22.369 +
  22.370 +section "Correctness of predicate-action diagram"
  22.371 +
  22.372 +
  22.373 +(* ========== Step 1.1 ================================================= *)
  22.374 +(* The implementation's initial condition implies the state predicate S1 *)
  22.375 +
  22.376 +lemma Step1_1: "|- ImpInit p & HInit rmhist p --> S1 rmhist p"
  22.377 +  by (tactic {* auto_tac (MI_fast_css addsimps2 [thm "MVNROKBA_def",
  22.378 +    thm "MClkInit_def", thm "RPCInit_def", thm "PInit_def", thm "HInit_def",
  22.379 +    thm "ImpInit_def", thm "S_def", thm "S1_def"]) *})
  22.380 +
  22.381 +(* ========== Step 1.2 ================================================== *)
  22.382 +(* Figure 16 is a predicate-action diagram for the implementation. *)
  22.383 +
  22.384 +lemma Step1_2_1: "|- [HNext rmhist p]_(c p,r p,m p, rmhist!p) & ImpNext p
  22.385 +         & ~unchanged (e p, c p, r p, m p, rmhist!p)  & $S1 rmhist p
  22.386 +         --> (S2 rmhist p)$ & ENext p & unchanged (c p, r p, m p)"
  22.387 +  apply (tactic {* action_simp_tac (simpset() addsimps [thm "ImpNext_def"]) []
  22.388 +      (map temp_elim [thm "S1ClerkUnch", thm "S1RPCUnch", thm "S1MemUnch", thm "S1Hist"]) 1 *})
  22.389 +   apply (tactic {* auto_tac (MI_fast_css addSIs2 [temp_use (thm "S1Env")]) *})
  22.390 +  done
  22.391 +
  22.392 +lemma Step1_2_2: "|- [HNext rmhist p]_(c p,r p,m p, rmhist!p) & ImpNext p
  22.393 +         & ~unchanged (e p, c p, r p, m p, rmhist!p) & $S2 rmhist p
  22.394 +         --> (S3 rmhist p)$ & MClkFwd memCh crCh cst p
  22.395 +             & unchanged (e p, r p, m p, rmhist!p)"
  22.396 +  apply (tactic {* action_simp_tac (simpset() addsimps [thm "ImpNext_def"]) []
  22.397 +    (map temp_elim [thm "S2EnvUnch", thm "S2RPCUnch", thm "S2MemUnch", thm "S2Hist"]) 1 *})
  22.398 +   apply (tactic {* auto_tac (MI_fast_css addSIs2 [temp_use (thm "S2Clerk"),
  22.399 +     temp_use (thm "S2Forward")]) *})
  22.400 +  done
  22.401 +
  22.402 +lemma Step1_2_3: "|- [HNext rmhist p]_(c p,r p,m p, rmhist!p) & ImpNext p
  22.403 +         & ~unchanged (e p, c p, r p, m p, rmhist!p) & $S3 rmhist p
  22.404 +         --> ((S4 rmhist p)$ & RPCFwd crCh rmCh rst p & unchanged (e p, c p, m p, rmhist!p))
  22.405 +             | ((S6 rmhist p)$ & RPCFail crCh rmCh rst p & unchanged (e p, c p, m p))"
  22.406 +  apply (tactic {* action_simp_tac (simpset() addsimps [thm "ImpNext_def"]) []
  22.407 +    (map temp_elim [thm "S3EnvUnch", thm "S3ClerkUnch", thm "S3MemUnch"]) 1 *})
  22.408 +  apply (tactic {* action_simp_tac (simpset()) []
  22.409 +    (thm "squareE" :: map temp_elim [thm "S3RPC", thm "S3Forward", thm "S3Fail"]) 1 *})
  22.410 +   apply (auto dest!: S3Hist [temp_use])
  22.411 +  done
  22.412 +
  22.413 +lemma Step1_2_4: "|- [HNext rmhist p]_(c p,r p,m p, rmhist!p) & ImpNext p
  22.414 +              & ~unchanged (e p, c p, r p, m p, rmhist!p)
  22.415 +              & $S4 rmhist p & (!l. $(MemInv mm l))
  22.416 +         --> ((S4 rmhist p)$ & Read rmCh mm ires p & unchanged (e p, c p, r p, rmhist!p))
  22.417 +             | ((S4 rmhist p)$ & (? l. Write rmCh mm ires p l) & unchanged (e p, c p, r p, rmhist!p))
  22.418 +             | ((S5 rmhist p)$ & MemReturn rmCh ires p & unchanged (e p, c p, r p))"
  22.419 +  apply (tactic {* action_simp_tac (simpset() addsimps [thm "ImpNext_def"]) []
  22.420 +    (map temp_elim [thm "S4EnvUnch", thm "S4ClerkUnch", thm "S4RPCUnch"]) 1 *})
  22.421 +  apply (tactic {* action_simp_tac (simpset() addsimps [thm "RNext_def"]) []
  22.422 +    (thm "squareE" :: map temp_elim [thm "S4Read", thm "S4Write", thm "S4Return"]) 1 *})
  22.423 +  apply (auto dest!: S4Hist [temp_use])
  22.424 +  done
  22.425 +
  22.426 +lemma Step1_2_5: "|- [HNext rmhist p]_(c p,r p,m p, rmhist!p) & ImpNext p
  22.427 +              & ~unchanged (e p, c p, r p, m p, rmhist!p) & $S5 rmhist p
  22.428 +         --> ((S6 rmhist p)$ & RPCReply crCh rmCh rst p & unchanged (e p, c p, m p))
  22.429 +             | ((S6 rmhist p)$ & RPCFail crCh rmCh rst p & unchanged (e p, c p, m p))"
  22.430 +  apply (tactic {* action_simp_tac (simpset() addsimps [thm "ImpNext_def"]) []
  22.431 +    (map temp_elim [thm "S5EnvUnch", thm "S5ClerkUnch", thm "S5MemUnch", thm "S5Hist"]) 1 *})
  22.432 +  apply (tactic {* action_simp_tac (simpset()) [] [thm "squareE", temp_elim (thm "S5RPC")] 1 *})
  22.433 +   apply (tactic {* auto_tac (MI_fast_css addSDs2
  22.434 +     [temp_use (thm "S5Reply"), temp_use (thm "S5Fail")]) *})
  22.435 +  done
  22.436 +
  22.437 +lemma Step1_2_6: "|- [HNext rmhist p]_(c p,r p,m p, rmhist!p) & ImpNext p
  22.438 +              & ~unchanged (e p, c p, r p, m p, rmhist!p) & $S6 rmhist p
  22.439 +         --> ((S1 rmhist p)$ & MClkReply memCh crCh cst p & unchanged (e p, r p, m p))
  22.440 +             | ((S3 rmhist p)$ & MClkRetry memCh crCh cst p & unchanged (e p,r p,m p,rmhist!p))"
  22.441 +  apply (tactic {* action_simp_tac (simpset() addsimps [thm "ImpNext_def"]) []
  22.442 +    (map temp_elim [thm "S6EnvUnch", thm "S6RPCUnch", thm "S6MemUnch"]) 1 *})
  22.443 +  apply (tactic {* action_simp_tac (simpset()) []
  22.444 +    (thm "squareE" :: map temp_elim [thm "S6Clerk", thm "S6Retry", thm "S6Reply"]) 1 *})
  22.445 +     apply (auto dest: S6Hist [temp_use])
  22.446 +  done
  22.447 +
  22.448 +(* --------------------------------------------------------------------------
  22.449 +   Step 1.3: S1 implies the barred initial condition.
  22.450 +*)
  22.451 +
  22.452 +section "Initialization (Step 1.3)"
  22.453 +
  22.454 +lemma Step1_3: "|- S1 rmhist p --> PInit (resbar rmhist) p"
  22.455 +  by (tactic {* action_simp_tac (simpset () addsimps [thm "resbar_def",
  22.456 +    thm "PInit_def", thm "S_def", thm "S1_def"]) [] [] 1 *})
  22.457 +
  22.458 +(* ----------------------------------------------------------------------
  22.459 +   Step 1.4: Implementation's next-state relation simulates specification's
  22.460 +             next-state relation (with appropriate substitutions)
  22.461 +*)
  22.462 +
  22.463 +section "Step simulation (Step 1.4)"
  22.464 +
  22.465 +lemma Step1_4_1: "|- ENext p & $S1 rmhist p & (S2 rmhist p)$ & unchanged (c p, r p, m p)
  22.466 +         --> unchanged (rtrner memCh!p, resbar rmhist!p)"
  22.467 +  by (tactic {* auto_tac (MI_fast_css addsimps2 [thm "c_def", thm "r_def",
  22.468 +    thm "m_def", thm "resbar_def"]) *})
  22.469 +
  22.470 +lemma Step1_4_2: "|- MClkFwd memCh crCh cst p & $S2 rmhist p & (S3 rmhist p)$
  22.471 +         & unchanged (e p, r p, m p, rmhist!p)
  22.472 +         --> unchanged (rtrner memCh!p, resbar rmhist!p)"
  22.473 +  by (tactic {* action_simp_tac
  22.474 +    (simpset() addsimps [thm "MClkFwd_def", thm "e_def", thm "r_def", thm "m_def",
  22.475 +    thm "resbar_def", thm "S_def", thm "S2_def", thm "S3_def"]) [] [] 1 *})
  22.476 +
  22.477 +lemma Step1_4_3a: "|- RPCFwd crCh rmCh rst p & $S3 rmhist p & (S4 rmhist p)$
  22.478 +         & unchanged (e p, c p, m p, rmhist!p)
  22.479 +         --> unchanged (rtrner memCh!p, resbar rmhist!p)"
  22.480 +  apply clarsimp
  22.481 +  apply (drule S3_excl [temp_use] S4_excl [temp_use])+
  22.482 +  apply (tactic {* action_simp_tac (simpset () addsimps [thm "e_def",
  22.483 +    thm "c_def", thm "m_def", thm "resbar_def", thm "S_def", thm "S3_def"]) [] [] 1 *})
  22.484 +  done
  22.485 +
  22.486 +lemma Step1_4_3b: "|- RPCFail crCh rmCh rst p & $S3 rmhist p & (S6 rmhist p)$
  22.487 +         & unchanged (e p, c p, m p)
  22.488 +         --> MemFail memCh (resbar rmhist) p"
  22.489 +  apply clarsimp
  22.490 +  apply (drule S6_excl [temp_use])
  22.491 +  apply (auto simp: RPCFail_def MemFail_def e_def c_def m_def resbar_def)
  22.492 +    apply (force simp: S3_def S_def)
  22.493 +   apply (auto simp: Return_def)
  22.494 +  done
  22.495 +
  22.496 +lemma Step1_4_4a1: "|- $S4 rmhist p & (S4 rmhist p)$ & ReadInner rmCh mm ires p l
  22.497 +         & unchanged (e p, c p, r p, rmhist!p) & $MemInv mm l
  22.498 +         --> ReadInner memCh mm (resbar rmhist) p l"
  22.499 +  apply clarsimp
  22.500 +  apply (drule S4_excl [temp_use])+
  22.501 +  apply (tactic {* action_simp_tac (simpset () addsimps [thm "ReadInner_def",
  22.502 +    thm "GoodRead_def", thm "BadRead_def", thm "e_def", thm "c_def", thm "m_def"]) [] [] 1 *})
  22.503 +     apply (auto simp: resbar_def)
  22.504 +       apply (tactic {* ALLGOALS (action_simp_tac
  22.505 +                (simpset() addsimps [thm "RPCRelayArg_def", thm "MClkRelayArg_def",
  22.506 +                  thm "S_def", thm "S4_def", thm "RdRequest_def", thm "MemInv_def"])
  22.507 +                [] [thm "impE", thm "MemValNotAResultE"]) *})
  22.508 +  done
  22.509 +
  22.510 +lemma Step1_4_4a: "|- Read rmCh mm ires p & $S4 rmhist p & (S4 rmhist p)$
  22.511 +         & unchanged (e p, c p, r p, rmhist!p) & (!l. $(MemInv mm l))
  22.512 +         --> Read memCh mm (resbar rmhist) p"
  22.513 +  by (force simp: Read_def elim!: Step1_4_4a1 [temp_use])
  22.514 +
  22.515 +lemma Step1_4_4b1: "|- $S4 rmhist p & (S4 rmhist p)$ & WriteInner rmCh mm ires p l v
  22.516 +         & unchanged (e p, c p, r p, rmhist!p)
  22.517 +         --> WriteInner memCh mm (resbar rmhist) p l v"
  22.518 +  apply clarsimp
  22.519 +  apply (drule S4_excl [temp_use])+
  22.520 +  apply (tactic {* action_simp_tac (simpset () addsimps
  22.521 +    [thm "WriteInner_def", thm "GoodWrite_def", thm "BadWrite_def", thm "e_def",
  22.522 +    thm "c_def", thm "m_def"]) [] [] 1 *})
  22.523 +     apply (auto simp: resbar_def)
  22.524 +    apply (tactic {* ALLGOALS (action_simp_tac (simpset () addsimps
  22.525 +      [thm "RPCRelayArg_def", thm "MClkRelayArg_def", thm "S_def",
  22.526 +      thm "S4_def", thm "WrRequest_def"]) [] []) *})
  22.527 +  done
  22.528 +
  22.529 +lemma Step1_4_4b: "|- Write rmCh mm ires p l & $S4 rmhist p & (S4 rmhist p)$
  22.530 +         & unchanged (e p, c p, r p, rmhist!p)
  22.531 +         --> Write memCh mm (resbar rmhist) p l"
  22.532 +  by (force simp: Write_def elim!: Step1_4_4b1 [temp_use])
  22.533 +
  22.534 +lemma Step1_4_4c: "|- MemReturn rmCh ires p & $S4 rmhist p & (S5 rmhist p)$
  22.535 +         & unchanged (e p, c p, r p)
  22.536 +         --> unchanged (rtrner memCh!p, resbar rmhist!p)"
  22.537 +  apply (tactic {* action_simp_tac (simpset () addsimps [thm "e_def",
  22.538 +    thm "c_def", thm "r_def", thm "resbar_def"]) [] [] 1 *})
  22.539 +  apply (drule S4_excl [temp_use] S5_excl [temp_use])+
  22.540 +  apply (tactic {* auto_tac (MI_fast_css addsimps2 [thm "MemReturn_def", thm "Return_def"]) *})
  22.541 +  done
  22.542 +
  22.543 +lemma Step1_4_5a: "|- RPCReply crCh rmCh rst p & $S5 rmhist p & (S6 rmhist p)$
  22.544 +         & unchanged (e p, c p, m p)
  22.545 +         --> unchanged (rtrner memCh!p, resbar rmhist!p)"
  22.546 +  apply clarsimp
  22.547 +  apply (drule S5_excl [temp_use] S6_excl [temp_use])+
  22.548 +  apply (auto simp: e_def c_def m_def resbar_def)
  22.549 +   apply (auto simp: RPCReply_def Return_def S5_def S_def dest!: MVOKBAnotRF [temp_use])
  22.550 +  done
  22.551 +
  22.552 +lemma Step1_4_5b: "|- RPCFail crCh rmCh rst p & $S5 rmhist p & (S6 rmhist p)$
  22.553 +         & unchanged (e p, c p, m p)
  22.554 +         --> MemFail memCh (resbar rmhist) p"
  22.555 +  apply clarsimp
  22.556 +  apply (drule S6_excl [temp_use])
  22.557 +  apply (auto simp: e_def c_def m_def RPCFail_def Return_def MemFail_def resbar_def)
  22.558 +   apply (auto simp: S5_def S_def)
  22.559 +  done
  22.560 +
  22.561 +lemma Step1_4_6a: "|- MClkReply memCh crCh cst p & $S6 rmhist p & (S1 rmhist p)$
  22.562 +         & unchanged (e p, r p, m p)
  22.563 +         --> MemReturn memCh (resbar rmhist) p"
  22.564 +  apply clarsimp
  22.565 +  apply (drule S6_excl [temp_use])+
  22.566 +  apply (tactic {* action_simp_tac (simpset () addsimps [thm "e_def",
  22.567 +    thm "r_def", thm "m_def", thm "MClkReply_def", thm "MemReturn_def",
  22.568 +    thm "Return_def", thm "resbar_def"]) [] [] 1 *})
  22.569 +    apply simp_all (* simplify if-then-else *)
  22.570 +    apply (tactic {* ALLGOALS (action_simp_tac (simpset () addsimps
  22.571 +      [thm "MClkReplyVal_def", thm "S6_def", thm "S_def"]) [] [thm "MVOKBARFnotNR"]) *})
  22.572 +  done
  22.573 +
  22.574 +lemma Step1_4_6b: "|- MClkRetry memCh crCh cst p & $S6 rmhist p & (S3 rmhist p)$
  22.575 +         & unchanged (e p, r p, m p, rmhist!p)
  22.576 +         --> MemFail memCh (resbar rmhist) p"
  22.577 +  apply clarsimp
  22.578 +  apply (drule S3_excl [temp_use])+
  22.579 +  apply (tactic {* action_simp_tac (simpset () addsimps [thm "e_def", thm "r_def",
  22.580 +    thm "m_def", thm "MClkRetry_def", thm "MemFail_def", thm "resbar_def"]) [] [] 1 *})
  22.581 +   apply (auto simp: S6_def S_def)
  22.582 +  done
  22.583 +
  22.584 +lemma S_lemma: "|- unchanged (e p, c p, r p, m p, rmhist!p)
  22.585 +         --> unchanged (S rmhist ec cc rc cs rs hs1 hs2 p)"
  22.586 +  by (auto simp: e_def c_def r_def m_def caller_def rtrner_def S_def Calling_def)
  22.587 +
  22.588 +lemma Step1_4_7H: "|- unchanged (e p, c p, r p, m p, rmhist!p)
  22.589 +         --> unchanged (rtrner memCh!p, S1 rmhist p, S2 rmhist p, S3 rmhist p,
  22.590 +                        S4 rmhist p, S5 rmhist p, S6 rmhist p)"
  22.591 +  apply clarsimp
  22.592 +  apply (rule conjI)
  22.593 +   apply (force simp: c_def)
  22.594 +  apply (force simp: S1_def S2_def S3_def S4_def S5_def S6_def intro!: S_lemma [temp_use])
  22.595 +  done
  22.596 +
  22.597 +lemma Step1_4_7: "|- unchanged (e p, c p, r p, m p, rmhist!p)
  22.598 +         --> unchanged (rtrner memCh!p, resbar rmhist!p, S1 rmhist p, S2 rmhist p,
  22.599 +                        S3 rmhist p, S4 rmhist p, S5 rmhist p, S6 rmhist p)"
  22.600 +  apply (rule actionI)
  22.601 +  apply (unfold action_rews)
  22.602 +  apply (rule impI)
  22.603 +  apply (frule Step1_4_7H [temp_use])
  22.604 +  apply (auto simp: e_def c_def r_def m_def rtrner_def resbar_def)
  22.605 +  done
  22.606 +
  22.607 +(* Frequently needed abbreviation: distinguish between idling and non-idling
  22.608 +   steps of the implementation, and try to solve the idling case by simplification
  22.609 +*)
  22.610 +ML {*
  22.611 +local
  22.612 +  val actionI = thm "actionI";
  22.613 +  val action_rews = thms "action_rews";
  22.614 +  val Step1_4_7 = thm "Step1_4_7";
  22.615 +in
  22.616 +fun split_idle_tac simps i =
  22.617 +    EVERY [TRY (rtac actionI i),
  22.618 +           case_tac "(s,t) |= unchanged (e p, c p, r p, m p, rmhist!p)" i,
  22.619 +           rewrite_goals_tac action_rews,
  22.620 +           forward_tac [temp_use Step1_4_7] i,
  22.621 +           asm_full_simp_tac (simpset() addsimps simps) i
  22.622 +          ]
  22.623 +end
  22.624 +*}
  22.625 +(* ----------------------------------------------------------------------
  22.626 +   Combine steps 1.2 and 1.4 to prove that the implementation satisfies
  22.627 +   the specification's next-state relation.
  22.628 +*)
  22.629 +
  22.630 +(* Steps that leave all variables unchanged are safe, so I may assume
  22.631 +   that some variable changes in the proof that a step is safe. *)
  22.632 +lemma unchanged_safe: "|- (~unchanged (e p, c p, r p, m p, rmhist!p)
  22.633 +             --> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p))
  22.634 +         --> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)"
  22.635 +  apply (tactic {* split_idle_tac [thm "square_def"] 1 *})
  22.636 +  apply force
  22.637 +  done
  22.638 +(* turn into (unsafe, looping!) introduction rule *)
  22.639 +lemmas unchanged_safeI = impI [THEN unchanged_safe [action_use], standard]
  22.640 +
  22.641 +lemma S1safe: "|- $S1 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)
  22.642 +         --> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)"
  22.643 +  apply clarsimp
  22.644 +  apply (rule unchanged_safeI)
  22.645 +  apply (rule idle_squareI)
  22.646 +  apply (auto dest!: Step1_2_1 [temp_use] Step1_4_1 [temp_use])
  22.647 +  done
  22.648 +
  22.649 +lemma S2safe: "|- $S2 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)
  22.650 +         --> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)"
  22.651 +  apply clarsimp
  22.652 +  apply (rule unchanged_safeI)
  22.653 +  apply (rule idle_squareI)
  22.654 +  apply (auto dest!: Step1_2_2 [temp_use] Step1_4_2 [temp_use])
  22.655 +  done
  22.656 +
  22.657 +lemma S3safe: "|- $S3 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)
  22.658 +         --> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)"
  22.659 +  apply clarsimp
  22.660 +  apply (rule unchanged_safeI)
  22.661 +  apply (auto dest!: Step1_2_3 [temp_use])
  22.662 +  apply (auto simp: square_def UNext_def dest!: Step1_4_3a [temp_use] Step1_4_3b [temp_use])
  22.663 +  done
  22.664 +
  22.665 +lemma S4safe: "|- $S4 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)
  22.666 +         & (!l. $(MemInv mm l))
  22.667 +         --> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)"
  22.668 +  apply clarsimp
  22.669 +  apply (rule unchanged_safeI)
  22.670 +  apply (auto dest!: Step1_2_4 [temp_use])
  22.671 +     apply (auto simp: square_def UNext_def RNext_def
  22.672 +       dest!: Step1_4_4a [temp_use] Step1_4_4b [temp_use] Step1_4_4c [temp_use])
  22.673 +  done
  22.674 +
  22.675 +lemma S5safe: "|- $S5 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)
  22.676 +         --> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)"
  22.677 +  apply clarsimp
  22.678 +  apply (rule unchanged_safeI)
  22.679 +  apply (auto dest!: Step1_2_5 [temp_use])
  22.680 +  apply (auto simp: square_def UNext_def dest!: Step1_4_5a [temp_use] Step1_4_5b [temp_use])
  22.681 +  done
  22.682 +
  22.683 +lemma S6safe: "|- $S6 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)
  22.684 +         --> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)"
  22.685 +  apply clarsimp
  22.686 +  apply (rule unchanged_safeI)
  22.687 +  apply (auto dest!: Step1_2_6 [temp_use])
  22.688 +    apply (auto simp: square_def UNext_def RNext_def
  22.689 +      dest!: Step1_4_6a [temp_use] Step1_4_6b [temp_use])
  22.690 +  done
  22.691 +
  22.692 +(* ----------------------------------------------------------------------
  22.693 +   Step 1.5: Temporal refinement proof, based on previous steps.
  22.694 +*)
  22.695 +
  22.696 +section "The liveness part"
  22.697 +
  22.698 +(* Liveness assertions for the different implementation states, based on the
  22.699 +   fairness conditions. Prove subgoals of WF1 / SF1 rules as separate lemmas
  22.700 +   for readability. Reuse action proofs from safety part.
  22.701 +*)
  22.702 +
  22.703 +(* ------------------------------ State S1 ------------------------------ *)
  22.704 +
  22.705 +lemma S1_successors: "|- $S1 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)
  22.706 +         --> (S1 rmhist p)$ | (S2 rmhist p)$"
  22.707 +  apply (tactic "split_idle_tac [] 1")
  22.708 +  apply (auto dest!: Step1_2_1 [temp_use])
  22.709 +  done
  22.710 +
  22.711 +(* Show that the implementation can satisfy the high-level fairness requirements
  22.712 +   by entering the state S1 infinitely often.
  22.713 +*)
  22.714 +
  22.715 +lemma S1_RNextdisabled: "|- S1 rmhist p -->
  22.716 +         ~Enabled (<RNext memCh mm (resbar rmhist) p>_(rtrner memCh!p, resbar rmhist!p))"
  22.717 +  apply (tactic {* action_simp_tac (simpset () addsimps [thm "angle_def",
  22.718 +    thm "S_def", thm "S1_def"]) [notI] [thm "enabledE", temp_elim (thm "Memoryidle")] 1 *})
  22.719 +  apply force
  22.720 +  done
  22.721 +
  22.722 +lemma S1_Returndisabled: "|- S1 rmhist p -->
  22.723 +         ~Enabled (<MemReturn memCh (resbar rmhist) p>_(rtrner memCh!p, resbar rmhist!p))"
  22.724 +  by (tactic {* action_simp_tac (simpset () addsimps [thm "angle_def", thm "MemReturn_def",
  22.725 +    thm "Return_def", thm "S_def", thm "S1_def"]) [notI] [thm "enabledE"] 1 *})
  22.726 +
  22.727 +lemma RNext_fair: "|- []<>S1 rmhist p
  22.728 +         --> WF(RNext memCh mm (resbar rmhist) p)_(rtrner memCh!p, resbar rmhist!p)"
  22.729 +  by (auto simp: WF_alt [try_rewrite] intro!: S1_RNextdisabled [temp_use]
  22.730 +    elim!: STL4E [temp_use] DmdImplE [temp_use])
  22.731 +
  22.732 +lemma Return_fair: "|- []<>S1 rmhist p
  22.733 +         --> WF(MemReturn memCh (resbar rmhist) p)_(rtrner memCh!p, resbar rmhist!p)"
  22.734 +  by (auto simp: WF_alt [try_rewrite]
  22.735 +    intro!: S1_Returndisabled [temp_use] elim!: STL4E [temp_use] DmdImplE [temp_use])
  22.736 +
  22.737 +(* ------------------------------ State S2 ------------------------------ *)
  22.738 +
  22.739 +lemma S2_successors: "|- $S2 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)
  22.740 +         --> (S2 rmhist p)$ | (S3 rmhist p)$"
  22.741 +  apply (tactic "split_idle_tac [] 1")
  22.742 +  apply (auto dest!: Step1_2_2 [temp_use])
  22.743 +  done
  22.744 +
  22.745 +lemma S2MClkFwd_successors: "|- ($S2 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p))
  22.746 +         & <MClkFwd memCh crCh cst p>_(c p)
  22.747 +         --> (S3 rmhist p)$"
  22.748 +  by (auto simp: angle_def dest!: Step1_2_2 [temp_use])
  22.749 +
  22.750 +lemma S2MClkFwd_enabled: "|- $S2 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)
  22.751 +         --> $Enabled (<MClkFwd memCh crCh cst p>_(c p))"
  22.752 +  apply (auto simp: c_def intro!: MClkFwd_ch_enabled [temp_use] MClkFwd_enabled [temp_use])
  22.753 +     apply (cut_tac MI_base)
  22.754 +     apply (blast dest: base_pair)
  22.755 +    apply (simp_all add: S_def S2_def)
  22.756 +  done
  22.757 +
  22.758 +lemma S2_live: "|- [](ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p))
  22.759 +         & WF(MClkFwd memCh crCh cst p)_(c p)
  22.760 +         --> (S2 rmhist p ~> S3 rmhist p)"
  22.761 +  by (rule WF1 S2_successors S2MClkFwd_successors S2MClkFwd_enabled)+
  22.762 +
  22.763 +(* ------------------------------ State S3 ------------------------------ *)
  22.764 +
  22.765 +lemma S3_successors: "|- $S3 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)
  22.766 +         --> (S3 rmhist p)$ | (S4 rmhist p | S6 rmhist p)$"
  22.767 +  apply (tactic "split_idle_tac [] 1")
  22.768 +  apply (auto dest!: Step1_2_3 [temp_use])
  22.769 +  done
  22.770 +
  22.771 +lemma S3RPC_successors: "|- ($S3 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p))
  22.772 +         & <RPCNext crCh rmCh rst p>_(r p)
  22.773 +         --> (S4 rmhist p | S6 rmhist p)$"
  22.774 +  apply (auto simp: angle_def dest!: Step1_2_3 [temp_use])
  22.775 +  done
  22.776 +
  22.777 +lemma S3RPC_enabled: "|- $S3 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)
  22.778 +         --> $Enabled (<RPCNext crCh rmCh rst p>_(r p))"
  22.779 +  apply (auto simp: r_def intro!: RPCFail_Next_enabled [temp_use] RPCFail_enabled [temp_use])
  22.780 +    apply (cut_tac MI_base)
  22.781 +    apply (blast dest: base_pair)
  22.782 +   apply (simp_all add: S_def S3_def)
  22.783 +  done
  22.784 +
  22.785 +lemma S3_live: "|- [](ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p))
  22.786 +         & WF(RPCNext crCh rmCh rst p)_(r p)
  22.787 +         --> (S3 rmhist p ~> S4 rmhist p | S6 rmhist p)"
  22.788 +  by (rule WF1 S3_successors S3RPC_successors S3RPC_enabled)+
  22.789 +
  22.790 +(* ------------- State S4 -------------------------------------------------- *)
  22.791 +
  22.792 +lemma S4_successors: "|- $S4 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)
  22.793 +        & (ALL l. $MemInv mm l)
  22.794 +        --> (S4 rmhist p)$ | (S5 rmhist p)$"
  22.795 +  apply (tactic "split_idle_tac [] 1")
  22.796 +  apply (auto dest!: Step1_2_4 [temp_use])
  22.797 +  done
  22.798 +
  22.799 +(* --------- State S4a: S4 /\ (ires p = NotAResult) ------------------------ *)
  22.800 +
  22.801 +lemma S4a_successors: "|- $(S4 rmhist p & ires!p = #NotAResult)
  22.802 +         & ImpNext p & [HNext rmhist p]_(c p,r p,m p,rmhist!p) & (ALL l. $MemInv mm l)
  22.803 +         --> (S4 rmhist p & ires!p = #NotAResult)$
  22.804 +             | ((S4 rmhist p & ires!p ~= #NotAResult) | S5 rmhist p)$"
  22.805 +  apply (tactic {* split_idle_tac [thm "m_def"] 1 *})
  22.806 +  apply (auto dest!: Step1_2_4 [temp_use])
  22.807 +  done
  22.808 +
  22.809 +lemma S4aRNext_successors: "|- ($(S4 rmhist p & ires!p = #NotAResult)
  22.810 +         & ImpNext p & [HNext rmhist p]_(c p,r p,m p,rmhist!p) & (ALL l. $MemInv mm l))
  22.811 +         & <RNext rmCh mm ires p>_(m p)
  22.812 +         --> ((S4 rmhist p & ires!p ~= #NotAResult) | S5 rmhist p)$"
  22.813 +  by (auto simp: angle_def
  22.814 +    dest!: Step1_2_4 [temp_use] ReadResult [temp_use] WriteResult [temp_use])
  22.815 +
  22.816 +lemma S4aRNext_enabled: "|- $(S4 rmhist p & ires!p = #NotAResult)
  22.817 +         & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) & (ALL l. $MemInv mm l)
  22.818 +         --> $Enabled (<RNext rmCh mm ires p>_(m p))"
  22.819 +  apply (auto simp: m_def intro!: RNext_enabled [temp_use])
  22.820 +   apply (cut_tac MI_base)
  22.821 +   apply (blast dest: base_pair)
  22.822 +  apply (simp add: S_def S4_def)
  22.823 +  done
  22.824 +
  22.825 +lemma S4a_live: "|- [](ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)
  22.826 +         & (ALL l. $MemInv mm l)) & WF(RNext rmCh mm ires p)_(m p)
  22.827 +         --> (S4 rmhist p & ires!p = #NotAResult
  22.828 +              ~> (S4 rmhist p & ires!p ~= #NotAResult) | S5 rmhist p)"
  22.829 +  by (rule WF1 S4a_successors S4aRNext_successors S4aRNext_enabled)+
  22.830 +
  22.831 +(* ---------- State S4b: S4 /\ (ires p # NotAResult) --------------------------- *)
  22.832 +
  22.833 +lemma S4b_successors: "|- $(S4 rmhist p & ires!p ~= #NotAResult)
  22.834 +         & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) & (ALL l. $MemInv mm l)
  22.835 +         --> (S4 rmhist p & ires!p ~= #NotAResult)$ | (S5 rmhist p)$"
  22.836 +  apply (tactic {* split_idle_tac [thm "m_def"] 1 *})
  22.837 +  apply (auto dest!: WriteResult [temp_use] Step1_2_4 [temp_use] ReadResult [temp_use])
  22.838 +  done
  22.839 +
  22.840 +lemma S4bReturn_successors: "|- ($(S4 rmhist p & ires!p ~= #NotAResult)
  22.841 +         & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)
  22.842 +         & (ALL l. $MemInv mm l)) & <MemReturn rmCh ires p>_(m p)
  22.843 +         --> (S5 rmhist p)$"
  22.844 +  by (force simp: angle_def dest!: Step1_2_4 [temp_use] dest: ReturnNotReadWrite [temp_use])
  22.845 +
  22.846 +lemma S4bReturn_enabled: "|- $(S4 rmhist p & ires!p ~= #NotAResult)
  22.847 +         & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)
  22.848 +         & (ALL l. $MemInv mm l)
  22.849 +         --> $Enabled (<MemReturn rmCh ires p>_(m p))"
  22.850 +  apply (auto simp: m_def intro!: MemReturn_enabled [temp_use])
  22.851 +   apply (cut_tac MI_base)
  22.852 +   apply (blast dest: base_pair)
  22.853 +  apply (simp add: S_def S4_def)
  22.854 +  done
  22.855 +
  22.856 +lemma S4b_live: "|- [](ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) & (!l. $MemInv mm l))
  22.857 +         & WF(MemReturn rmCh ires p)_(m p)
  22.858 +         --> (S4 rmhist p & ires!p ~= #NotAResult ~> S5 rmhist p)"
  22.859 +  by (rule WF1 S4b_successors S4bReturn_successors S4bReturn_enabled)+
  22.860 +
  22.861 +(* ------------------------------ State S5 ------------------------------ *)
  22.862 +
  22.863 +lemma S5_successors: "|- $S5 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)
  22.864 +         --> (S5 rmhist p)$ | (S6 rmhist p)$"
  22.865 +  apply (tactic "split_idle_tac [] 1")
  22.866 +  apply (auto dest!: Step1_2_5 [temp_use])
  22.867 +  done
  22.868 +
  22.869 +lemma S5RPC_successors: "|- ($S5 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p))
  22.870 +         & <RPCNext crCh rmCh rst p>_(r p)
  22.871 +         --> (S6 rmhist p)$"
  22.872 +  by (auto simp: angle_def dest!: Step1_2_5 [temp_use])
  22.873 +
  22.874 +lemma S5RPC_enabled: "|- $S5 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)
  22.875 +         --> $Enabled (<RPCNext crCh rmCh rst p>_(r p))"
  22.876 +  apply (auto simp: r_def intro!: RPCFail_Next_enabled [temp_use] RPCFail_enabled [temp_use])
  22.877 +    apply (cut_tac MI_base)
  22.878 +    apply (blast dest: base_pair)
  22.879 +   apply (simp_all add: S_def S5_def)
  22.880 +  done
  22.881 +
  22.882 +lemma S5_live: "|- [](ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p))
  22.883 +         & WF(RPCNext crCh rmCh rst p)_(r p)
  22.884 +         --> (S5 rmhist p ~> S6 rmhist p)"
  22.885 +  by (rule WF1 S5_successors S5RPC_successors S5RPC_enabled)+
  22.886 +
  22.887 +(* ------------------------------ State S6 ------------------------------ *)
  22.888 +
  22.889 +lemma S6_successors: "|- $S6 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)
  22.890 +         --> (S1 rmhist p)$ | (S3 rmhist p)$ | (S6 rmhist p)$"
  22.891 +  apply (tactic "split_idle_tac [] 1")
  22.892 +  apply (auto dest!: Step1_2_6 [temp_use])
  22.893 +  done
  22.894 +
  22.895 +lemma S6MClkReply_successors:
  22.896 +  "|- ($S6 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p))
  22.897 +         & <MClkReply memCh crCh cst p>_(c p)
  22.898 +         --> (S1 rmhist p)$"
  22.899 +  by (auto simp: angle_def dest!: Step1_2_6 [temp_use] MClkReplyNotRetry [temp_use])
  22.900 +
  22.901 +lemma MClkReplyS6:
  22.902 +  "|- $ImpInv rmhist p & <MClkReply memCh crCh cst p>_(c p) --> $S6 rmhist p"
  22.903 +  by (tactic {* action_simp_tac (simpset () addsimps [thm "angle_def",
  22.904 +    thm "MClkReply_def", thm "Return_def", thm "ImpInv_def", thm "S_def",
  22.905 +    thm "S1_def", thm "S2_def", thm "S3_def", thm "S4_def", thm "S5_def"]) [] [] 1 *})
  22.906 +
  22.907 +lemma S6MClkReply_enabled: "|- S6 rmhist p --> Enabled (<MClkReply memCh crCh cst p>_(c p))"
  22.908 +  apply (auto simp: c_def intro!: MClkReply_enabled [temp_use])
  22.909 +     apply (cut_tac MI_base)
  22.910 +     apply (blast dest: base_pair)
  22.911 +    apply (tactic {* ALLGOALS (action_simp_tac (simpset ()
  22.912 +      addsimps [thm "S_def", thm "S6_def"]) [] []) *})
  22.913 +  done
  22.914 +
  22.915 +lemma S6_live: "|- [](ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) & $(ImpInv rmhist p))
  22.916 +         & SF(MClkReply memCh crCh cst p)_(c p) & []<>(S6 rmhist p)
  22.917 +         --> []<>(S1 rmhist p)"
  22.918 +  apply clarsimp
  22.919 +  apply (subgoal_tac "sigma |= []<> (<MClkReply memCh crCh cst p>_ (c p))")
  22.920 +   apply (erule InfiniteEnsures)
  22.921 +    apply assumption
  22.922 +   apply (tactic {* action_simp_tac (simpset()) []
  22.923 +     (map temp_elim [thm "MClkReplyS6", thm "S6MClkReply_successors"]) 1 *})
  22.924 +  apply (auto simp: SF_def)
  22.925 +  apply (erule contrapos_np)
  22.926 +  apply (auto intro!: S6MClkReply_enabled [temp_use] elim!: STL4E [temp_use] DmdImplE [temp_use])
  22.927 +  done
  22.928 +
  22.929 +(* --------------- aggregate leadsto properties----------------------------- *)
  22.930 +
  22.931 +lemma S5S6LeadstoS6: "sigma |= S5 rmhist p ~> S6 rmhist p
  22.932 +      ==> sigma |= (S5 rmhist p | S6 rmhist p) ~> S6 rmhist p"
  22.933 +  by (auto intro!: LatticeDisjunctionIntro [temp_use] LatticeReflexivity [temp_use])
  22.934 +
  22.935 +lemma S4bS5S6LeadstoS6: "[| sigma |= S4 rmhist p & ires!p ~= #NotAResult ~> S5 rmhist p;
  22.936 +         sigma |= S5 rmhist p ~> S6 rmhist p |]
  22.937 +      ==> sigma |= (S4 rmhist p & ires!p ~= #NotAResult) | S5 rmhist p | S6 rmhist p
  22.938 +                    ~> S6 rmhist p"
  22.939 +  by (auto intro!: LatticeDisjunctionIntro [temp_use]
  22.940 +    S5S6LeadstoS6 [temp_use] intro: LatticeTransitivity [temp_use])
  22.941 +
  22.942 +lemma S4S5S6LeadstoS6: "[| sigma |= S4 rmhist p & ires!p = #NotAResult
  22.943 +                  ~> (S4 rmhist p & ires!p ~= #NotAResult) | S5 rmhist p;
  22.944 +         sigma |= S4 rmhist p & ires!p ~= #NotAResult ~> S5 rmhist p;
  22.945 +         sigma |= S5 rmhist p ~> S6 rmhist p |]
  22.946 +      ==> sigma |= S4 rmhist p | S5 rmhist p | S6 rmhist p ~> S6 rmhist p"
  22.947 +  apply (subgoal_tac "sigma |= (S4 rmhist p & ires!p = #NotAResult) |
  22.948 +    (S4 rmhist p & ires!p ~= #NotAResult) | S5 rmhist p | S6 rmhist p ~> S6 rmhist p")
  22.949 +   apply (erule_tac G = "PRED ((S4 rmhist p & ires!p = #NotAResult) |
  22.950 +     (S4 rmhist p & ires!p ~= #NotAResult) | S5 rmhist p | S6 rmhist p)" in
  22.951 +     LatticeTransitivity [temp_use])
  22.952 +   apply (force simp: Init_defs intro!: ImplLeadsto_gen [temp_use] necT [temp_use])
  22.953 +  apply (rule LatticeDisjunctionIntro [temp_use])
  22.954 +   apply (erule LatticeTransitivity [temp_use])
  22.955 +   apply (erule LatticeTriangle2 [temp_use])
  22.956 +   apply assumption
  22.957 +  apply (auto intro!: S4bS5S6LeadstoS6 [temp_use])
  22.958 +  done
  22.959 +
  22.960 +lemma S3S4S5S6LeadstoS6: "[| sigma |= S3 rmhist p ~> S4 rmhist p | S6 rmhist p;
  22.961 +         sigma |= S4 rmhist p & ires!p = #NotAResult
  22.962 +                  ~> (S4 rmhist p & ires!p ~= #NotAResult) | S5 rmhist p;
  22.963 +         sigma |= S4 rmhist p & ires!p ~= #NotAResult ~> S5 rmhist p;
  22.964 +         sigma |= S5 rmhist p ~> S6 rmhist p |]
  22.965 +      ==> sigma |= S3 rmhist p | S4 rmhist p | S5 rmhist p | S6 rmhist p ~> S6 rmhist p"
  22.966 +  apply (rule LatticeDisjunctionIntro [temp_use])
  22.967 +   apply (erule LatticeTriangle2 [temp_use])
  22.968 +   apply (rule S4S5S6LeadstoS6 [THEN LatticeTransitivity [temp_use]])
  22.969 +      apply (auto intro!: S4S5S6LeadstoS6 [temp_use] necT [temp_use]
  22.970 +        intro: ImplLeadsto_gen [temp_use] simp: Init_defs)
  22.971 +  done
  22.972 +
  22.973 +lemma S2S3S4S5S6LeadstoS6: "[| sigma |= S2 rmhist p ~> S3 rmhist p;
  22.974 +         sigma |= S3 rmhist p ~> S4 rmhist p | S6 rmhist p;
  22.975 +         sigma |= S4 rmhist p & ires!p = #NotAResult
  22.976 +                  ~> S4 rmhist p & ires!p ~= #NotAResult | S5 rmhist p;
  22.977 +         sigma |= S4 rmhist p & ires!p ~= #NotAResult ~> S5 rmhist p;
  22.978 +         sigma |= S5 rmhist p ~> S6 rmhist p |]
  22.979 +      ==> sigma |= S2 rmhist p | S3 rmhist p | S4 rmhist p | S5 rmhist p | S6 rmhist p
  22.980 +                   ~> S6 rmhist p"
  22.981 +  apply (rule LatticeDisjunctionIntro [temp_use])
  22.982 +   apply (rule LatticeTransitivity [temp_use])
  22.983 +    prefer 2 apply assumption
  22.984 +   apply (rule S3S4S5S6LeadstoS6 [THEN LatticeTransitivity [temp_use]])
  22.985 +       apply (auto intro!: S3S4S5S6LeadstoS6 [temp_use] necT [temp_use]
  22.986 +         intro: ImplLeadsto_gen [temp_use] simp: Init_defs)
  22.987 +  done
  22.988 +
  22.989 +lemma NotS1LeadstoS6: "[| sigma |= []ImpInv rmhist p;
  22.990 +         sigma |= S2 rmhist p ~> S3 rmhist p;
  22.991 +         sigma |= S3 rmhist p ~> S4 rmhist p | S6 rmhist p;
  22.992 +         sigma |= S4 rmhist p & ires!p = #NotAResult
  22.993 +                  ~> S4 rmhist p & ires!p ~= #NotAResult | S5 rmhist p;
  22.994 +         sigma |= S4 rmhist p & ires!p ~= #NotAResult ~> S5 rmhist p;
  22.995 +         sigma |= S5 rmhist p ~> S6 rmhist p |]
  22.996 +      ==> sigma |= ~S1 rmhist p ~> S6 rmhist p"
  22.997 +  apply (rule S2S3S4S5S6LeadstoS6 [THEN LatticeTransitivity [temp_use]])
  22.998 +       apply assumption+
  22.999 +  apply (erule INV_leadsto [temp_use])
 22.1000 +  apply (rule ImplLeadsto_gen [temp_use])
 22.1001 +  apply (rule necT [temp_use])
 22.1002 +  apply (auto simp: ImpInv_def Init_defs intro!: necT [temp_use])
 22.1003 +  done
 22.1004 +
 22.1005 +lemma S1Infinite: "[| sigma |= ~S1 rmhist p ~> S6 rmhist p;
 22.1006 +         sigma |= []<>S6 rmhist p --> []<>S1 rmhist p |]
 22.1007 +      ==> sigma |= []<>S1 rmhist p"
 22.1008 +  apply (rule classical)
 22.1009 +  apply (tactic {* asm_lr_simp_tac (simpset() addsimps
 22.1010 +    [temp_use (thm "NotBox"), temp_rewrite (thm "NotDmd")]) 1 *})
 22.1011 +  apply (auto elim!: leadsto_infinite [temp_use] mp dest!: DBImplBD [temp_use])
 22.1012 +  done
 22.1013 +
 22.1014 +section "Refinement proof (step 1.5)"
 22.1015 +
 22.1016 +(* Prove invariants of the implementation:
 22.1017 +   a. memory invariant
 22.1018 +   b. "implementation invariant": always in states S1,...,S6
 22.1019 +*)
 22.1020 +lemma Step1_5_1a: "|- IPImp p --> (ALL l. []$MemInv mm l)"
 22.1021 +  by (auto simp: IPImp_def box_stp_act [temp_use] intro!: MemoryInvariantAll [temp_use])
 22.1022 +
 22.1023 +lemma Step1_5_1b: "|- Init(ImpInit p & HInit rmhist p) & [](ImpNext p)
 22.1024 +         & [][HNext rmhist p]_(c p, r p, m p, rmhist!p) & [](ALL l. $MemInv mm l)
 22.1025 +         --> []ImpInv rmhist p"
 22.1026 +  apply (tactic "inv_tac MI_css 1")
 22.1027 +   apply (auto simp: Init_def ImpInv_def box_stp_act [temp_use]
 22.1028 +     dest!: Step1_1 [temp_use] dest: S1_successors [temp_use] S2_successors [temp_use]
 22.1029 +     S3_successors [temp_use] S4_successors [temp_use] S5_successors [temp_use]
 22.1030 +     S6_successors [temp_use])
 22.1031 +  done
 22.1032 +
 22.1033 +(*** Initialization ***)
 22.1034 +lemma Step1_5_2a: "|- Init(ImpInit p & HInit rmhist p) --> Init(PInit (resbar rmhist) p)"
 22.1035 +  by (auto simp: Init_def intro!: Step1_1 [temp_use] Step1_3  [temp_use])
 22.1036 +
 22.1037 +(*** step simulation ***)
 22.1038 +lemma Step1_5_2b: "|- [](ImpNext p & [HNext rmhist p]_(c p, r p, m p, rmhist!p)
 22.1039 +         & $ImpInv rmhist p & (!l. $MemInv mm l))
 22.1040 +         --> [][UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)"
 22.1041 +  by (auto simp: ImpInv_def elim!: STL4E [temp_use]
 22.1042 +    dest!: S1safe [temp_use] S2safe [temp_use] S3safe [temp_use] S4safe [temp_use]
 22.1043 +    S5safe [temp_use] S6safe [temp_use])
 22.1044 +
 22.1045 +(*** Liveness ***)
 22.1046 +lemma GoodImpl: "|- IPImp p & HistP rmhist p
 22.1047 +         -->   Init(ImpInit p & HInit rmhist p)
 22.1048 +             & [](ImpNext p & [HNext rmhist p]_(c p, r p, m p, rmhist!p))
 22.1049 +             & [](ALL l. $MemInv mm l) & []($ImpInv rmhist p)
 22.1050 +             & ImpLive p"
 22.1051 +  apply clarsimp
 22.1052 +    apply (subgoal_tac "sigma |= Init (ImpInit p & HInit rmhist p) & [] (ImpNext p) &
 22.1053 +      [][HNext rmhist p]_ (c p, r p, m p, rmhist!p) & [] (ALL l. $MemInv mm l)")
 22.1054 +   apply (auto simp: split_box_conj [try_rewrite] box_stp_act [try_rewrite]
 22.1055 +       dest!: Step1_5_1b [temp_use])
 22.1056 +      apply (force simp: IPImp_def MClkIPSpec_def RPCIPSpec_def RPSpec_def
 22.1057 +        ImpLive_def c_def r_def m_def)
 22.1058 +      apply (force simp: IPImp_def MClkIPSpec_def RPCIPSpec_def RPSpec_def
 22.1059 +        HistP_def Init_def ImpInit_def)
 22.1060 +    apply (force simp: IPImp_def MClkIPSpec_def RPCIPSpec_def RPSpec_def
 22.1061 +      ImpNext_def c_def r_def m_def split_box_conj [temp_use])
 22.1062 +   apply (force simp: HistP_def)
 22.1063 +  apply (force simp: allT [temp_use] dest!: Step1_5_1a [temp_use])
 22.1064 +  done
 22.1065 +
 22.1066 +(* The implementation is infinitely often in state S1... *)
 22.1067 +lemma Step1_5_3a: "|- [](ImpNext p & [HNext rmhist p]_(c p, r p, m p, rmhist!p))
 22.1068 +         & [](ALL l. $MemInv mm l)
 22.1069 +         & []($ImpInv rmhist p) & ImpLive p
 22.1070 +         --> []<>S1 rmhist p"
 22.1071 +  apply (clarsimp simp: ImpLive_def)
 22.1072 +  apply (rule S1Infinite)
 22.1073 +   apply (force simp: split_box_conj [try_rewrite] box_stp_act [try_rewrite]
 22.1074 +     intro!: NotS1LeadstoS6 [temp_use] S2_live [temp_use] S3_live [temp_use]
 22.1075 +     S4a_live [temp_use] S4b_live [temp_use] S5_live [temp_use])
 22.1076 +  apply (auto simp: split_box_conj [temp_use] intro!: S6_live [temp_use])
 22.1077 +  done
 22.1078 +
 22.1079 +(* ... and therefore satisfies the fairness requirements of the specification *)
 22.1080 +lemma Step1_5_3b: "|- [](ImpNext p & [HNext rmhist p]_(c p, r p, m p, rmhist!p))
 22.1081 +         & [](ALL l. $MemInv mm l) & []($ImpInv rmhist p) & ImpLive p
 22.1082 +         --> WF(RNext memCh mm (resbar rmhist) p)_(rtrner memCh!p, resbar rmhist!p)"
 22.1083 +  by (auto intro!: RNext_fair [temp_use] Step1_5_3a [temp_use])
 22.1084 +
 22.1085 +lemma Step1_5_3c: "|- [](ImpNext p & [HNext rmhist p]_(c p, r p, m p, rmhist!p))
 22.1086 +         & [](ALL l. $MemInv mm l) & []($ImpInv rmhist p) & ImpLive p
 22.1087 +         --> WF(MemReturn memCh (resbar rmhist) p)_(rtrner memCh!p, resbar rmhist!p)"
 22.1088 +  by (auto intro!: Return_fair [temp_use] Step1_5_3a [temp_use])
 22.1089 +
 22.1090 +(* QED step of step 1 *)
 22.1091 +lemma Step1: "|- IPImp p & HistP rmhist p --> UPSpec memCh mm (resbar rmhist) p"
 22.1092 +  by (auto simp: UPSpec_def split_box_conj [temp_use]
 22.1093 +    dest!: GoodImpl [temp_use] intro!: Step1_5_2a [temp_use] Step1_5_2b [temp_use]
 22.1094 +    Step1_5_3b [temp_use] Step1_5_3c [temp_use])
 22.1095 +
 22.1096 +(* ------------------------------ Step 2 ------------------------------ *)
 22.1097 +section "Step 2"
 22.1098 +
 22.1099 +lemma Step2_2a: "|- Write rmCh mm ires p l & ImpNext p
 22.1100 +         & [HNext rmhist p]_(c p, r p, m p, rmhist!p)
 22.1101 +         & $ImpInv rmhist p
 22.1102 +         --> (S4 rmhist p)$ & unchanged (e p, c p, r p, rmhist!p)"
 22.1103 +  apply clarsimp
 22.1104 +  apply (drule WriteS4 [action_use])
 22.1105 +   apply assumption
 22.1106 +  apply (tactic "split_idle_tac [] 1")
 22.1107 +  apply (auto simp: ImpNext_def dest!: S4EnvUnch [temp_use] S4ClerkUnch [temp_use]
 22.1108 +    S4RPCUnch [temp_use])
 22.1109 +     apply (auto simp: square_def dest: S4Write [temp_use])
 22.1110 +  done
 22.1111 +
 22.1112 +lemma Step2_2: "|-   (ALL p. ImpNext p)
 22.1113 +         & (ALL p. [HNext rmhist p]_(c p, r p, m p, rmhist!p))
 22.1114 +         & (ALL p. $ImpInv rmhist p)
 22.1115 +         & [EX q. Write rmCh mm ires q l]_(mm!l)
 22.1116 +         --> [EX q. Write memCh mm (resbar rmhist) q l]_(mm!l)"
 22.1117 +  apply (auto intro!: squareCI elim!: squareE)
 22.1118 +  apply (assumption | rule exI Step1_4_4b [action_use])+
 22.1119 +    apply (force intro!: WriteS4 [temp_use])
 22.1120 +   apply (auto dest!: Step2_2a [temp_use])
 22.1121 +  done
 22.1122 +
 22.1123 +lemma Step2_lemma: "|- [](  (ALL p. ImpNext p)
 22.1124 +            & (ALL p. [HNext rmhist p]_(c p, r p, m p, rmhist!p))
 22.1125 +            & (ALL p. $ImpInv rmhist p)
 22.1126 +            & [EX q. Write rmCh mm ires q l]_(mm!l))
 22.1127 +         --> [][EX q. Write memCh mm (resbar rmhist) q l]_(mm!l)"
 22.1128 +  by (force elim!: STL4E [temp_use] dest!: Step2_2 [temp_use])
 22.1129 +
 22.1130 +lemma Step2: "|- #l : #MemLoc & (ALL p. IPImp p & HistP rmhist p)
 22.1131 +         --> MSpec memCh mm (resbar rmhist) l"
 22.1132 +  apply (auto simp: MSpec_def)
 22.1133 +   apply (force simp: IPImp_def MSpec_def)
 22.1134 +  apply (auto intro!: Step2_lemma [temp_use] simp: split_box_conj [temp_use] all_box [temp_use])
 22.1135 +     prefer 4
 22.1136 +     apply (force simp: IPImp_def MSpec_def)
 22.1137 +    apply (auto simp: split_box_conj [temp_use] elim!: allE dest!: GoodImpl [temp_use])
 22.1138 +  done
 22.1139 +
 22.1140 +(* ----------------------------- Main theorem --------------------------------- *)
 22.1141 +section "Memory implementation"
 22.1142 +
 22.1143 +(* The combination of a legal caller, the memory clerk, the RPC component,
 22.1144 +   and a reliable memory implement the unreliable memory.
 22.1145 +*)
 22.1146 +
 22.1147 +(* Implementation of internal specification by combination of implementation
 22.1148 +   and history variable with explicit refinement mapping
 22.1149 +*)
 22.1150 +lemma Impl_IUSpec: "|- Implementation & Hist rmhist --> IUSpec memCh mm (resbar rmhist)"
 22.1151 +  by (auto simp: IUSpec_def Implementation_def IPImp_def MClkISpec_def
 22.1152 +    RPCISpec_def IRSpec_def Hist_def intro!: Step1 [temp_use] Step2 [temp_use])
 22.1153 +
 22.1154 +(* The main theorem: introduce hiding and eliminate history variable. *)
 22.1155 +lemma Implementation: "|- Implementation --> USpec memCh"
 22.1156 +  apply clarsimp
 22.1157 +  apply (frule History [temp_use])
 22.1158 +  apply (auto simp: USpec_def intro: eexI [temp_use] Impl_IUSpec [temp_use]
 22.1159 +    MI_base [temp_use] elim!: eexE)
 22.1160 +  done
 22.1161  
 22.1162  end
    23.1 --- a/src/HOL/TLA/Memory/MemoryParameters.ML	Fri Dec 01 17:22:33 2006 +0100
    23.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    23.3 @@ -1,19 +0,0 @@
    23.4 -(*
    23.5 -    File:        MemoryParameters.ML
    23.6 -    ID:          $Id$
    23.7 -    Author:      Stephan Merz
    23.8 -    Copyright:   1997 University of Munich
    23.9 -
   23.10 -    RPC-Memory example: memory parameters (ML file)
   23.11 -*)
   23.12 -
   23.13 -Addsimps ([BadArgNoMemVal,MemFailNoMemVal,InitValMemVal,NotAResultNotVal,
   23.14 -                  NotAResultNotOK, NotAResultNotBA, NotAResultNotMF]
   23.15 -               @ (map (fn x => x RS not_sym)
   23.16 -                      [NotAResultNotOK, NotAResultNotBA, NotAResultNotMF]));
   23.17 -
   23.18 -val prems = goal (the_context ()) "[| x : MemVal; (x ~= NotAResult ==> P) |] ==> P";
   23.19 -by (resolve_tac prems 1);
   23.20 -by (cut_facts_tac (NotAResultNotVal::prems) 1);
   23.21 -by (Force_tac 1);
   23.22 -qed "MemValNotAResultE";
    24.1 --- a/src/HOL/TLA/Memory/MemoryParameters.thy	Fri Dec 01 17:22:33 2006 +0100
    24.2 +++ b/src/HOL/TLA/Memory/MemoryParameters.thy	Sat Dec 02 02:52:02 2006 +0100
    24.3 @@ -3,12 +3,9 @@
    24.4      ID:          $Id$
    24.5      Author:      Stephan Merz
    24.6      Copyright:   1997 University of Munich
    24.7 +*)
    24.8  
    24.9 -    Theory Name: MemoryParameters
   24.10 -    Logic Image: TLA
   24.11 -
   24.12 -    RPC-Memory example: Memory parameters
   24.13 -*)
   24.14 +header {* RPC-Memory example: Memory parameters *}
   24.15  
   24.16  theory MemoryParameters
   24.17  imports RPCMemoryParams
   24.18 @@ -41,6 +38,12 @@
   24.19    NotAResultNotBA:   "NotAResult ~= BadArg"
   24.20    NotAResultNotMF:   "NotAResult ~= MemFailure"
   24.21  
   24.22 -ML {* use_legacy_bindings (the_context ()) *}
   24.23 +lemmas [simp] =
   24.24 +  BadArgNoMemVal MemFailNoMemVal InitValMemVal NotAResultNotVal
   24.25 +  NotAResultNotOK NotAResultNotBA NotAResultNotMF
   24.26 +  NotAResultNotOK [symmetric] NotAResultNotBA [symmetric] NotAResultNotMF [symmetric]
   24.27 +
   24.28 +lemma MemValNotAResultE: "[| x : MemVal; (x ~= NotAResult ==> P) |] ==> P"
   24.29 +  using NotAResultNotVal by blast
   24.30  
   24.31  end
    25.1 --- a/src/HOL/TLA/Memory/ProcedureInterface.ML	Fri Dec 01 17:22:33 2006 +0100
    25.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    25.3 @@ -1,28 +0,0 @@
    25.4 -(*
    25.5 -    File:        ProcedureInterface.ML
    25.6 -    ID:          $Id$
    25.7 -    Author:      Stephan Merz
    25.8 -    Copyright:   1997 University of Munich
    25.9 -
   25.10 -    Procedure interface (theorems and proofs)
   25.11 -*)
   25.12 -
   25.13 -Addsimps [slice_def];
   25.14 -val mem_css = (claset(), simpset());
   25.15 -
   25.16 -(* ---------------------------------------------------------------------------- *)
   25.17 -
   25.18 -val Procedure_defs = [caller_def, rtrner_def, Calling_def,
   25.19 -                      Call_def, Return_def,
   25.20 -                      PLegalCaller_def, LegalCaller_def,
   25.21 -                      PLegalReturner_def, LegalReturner_def];
   25.22 -
   25.23 -(* Calls and returns change their subchannel *)
   25.24 -Goal "|- Call ch p v --> <Call ch p v>_((caller ch)!p)";
   25.25 -by (auto_tac (mem_css addsimps2 [angle_def,Call_def,caller_def,Calling_def]));
   25.26 -qed "Call_changed";
   25.27 -
   25.28 -Goal "|- Return ch p v --> <Return ch p v>_((rtrner ch)!p)";
   25.29 -by (auto_tac (mem_css addsimps2 [angle_def,Return_def,rtrner_def,Calling_def]));
   25.30 -qed "Return_changed";
   25.31 -
    26.1 --- a/src/HOL/TLA/Memory/ProcedureInterface.thy	Fri Dec 01 17:22:33 2006 +0100
    26.2 +++ b/src/HOL/TLA/Memory/ProcedureInterface.thy	Sat Dec 02 02:52:02 2006 +0100
    26.3 @@ -3,12 +3,9 @@
    26.4      ID:          $Id$
    26.5      Author:      Stephan Merz
    26.6      Copyright:   1997 University of Munich
    26.7 +*)
    26.8  
    26.9 -   Theory Name: ProcedureInterface
   26.10 -   Logic Image: TLA
   26.11 -
   26.12 -   Procedure interface for RPC-Memory components.
   26.13 -*)
   26.14 +header {* Procedure interface for RPC-Memory components *}
   26.15  
   26.16  theory ProcedureInterface
   26.17  imports TLA RPCMemoryParams
   26.18 @@ -84,6 +81,16 @@
   26.19                                  [][ ? v. Return ch p v ]_((rtrner ch)!p)"
   26.20    LegalReturner_def:     "LegalReturner ch == TEMP (! p. PLegalReturner ch p)"
   26.21  
   26.22 -ML {* use_legacy_bindings (the_context ()) *}
   26.23 +declare slice_def [simp]
   26.24 +
   26.25 +lemmas Procedure_defs = caller_def rtrner_def Calling_def Call_def Return_def
   26.26 +  PLegalCaller_def LegalCaller_def PLegalReturner_def LegalReturner_def
   26.27 +
   26.28 +(* Calls and returns change their subchannel *)
   26.29 +lemma Call_changed: "|- Call ch p v --> <Call ch p v>_((caller ch)!p)"
   26.30 +  by (auto simp: angle_def Call_def caller_def Calling_def)
   26.31 +
   26.32 +lemma Return_changed: "|- Return ch p v --> <Return ch p v>_((rtrner ch)!p)"
   26.33 +  by (auto simp: angle_def Return_def rtrner_def Calling_def)
   26.34  
   26.35  end
    27.1 --- a/src/HOL/TLA/Memory/RPC.ML	Fri Dec 01 17:22:33 2006 +0100
    27.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    27.3 @@ -1,53 +0,0 @@
    27.4 -(*
    27.5 -    File:        RPC.ML
    27.6 -    ID:          $Id$
    27.7 -    Author:      Stephan Merz
    27.8 -    Copyright:   1997 University of Munich
    27.9 -
   27.10 -    RPC-Memory example: RPC specification (theorems and proofs)
   27.11 -*)
   27.12 -
   27.13 -val RPC_action_defs = [RPCInit_def, RPCFwd_def, RPCReject_def, RPCFail_def,
   27.14 -                       RPCReply_def, RPCNext_def];
   27.15 -
   27.16 -val RPC_temp_defs = [RPCIPSpec_def, RPCISpec_def];
   27.17 -
   27.18 -val mem_css = (claset(), simpset());
   27.19 -
   27.20 -(* The RPC component engages in an action for process p only if there is an outstanding,
   27.21 -   unanswered call for that process.
   27.22 -*)
   27.23 -
   27.24 -Goal "|- ~$(Calling send p) --> ~RPCNext send rcv rst p";
   27.25 -by (auto_tac (mem_css addsimps2 (Return_def::RPC_action_defs)));
   27.26 -qed "RPCidle";
   27.27 -
   27.28 -Goal "|- $(Calling rcv p) & $(rst!p) = #rpcB --> ~RPCNext send rcv rst p";
   27.29 -by (auto_tac (mem_css addsimps2 RPC_action_defs));
   27.30 -qed "RPCbusy";
   27.31 -
   27.32 -(* RPC failure actions are visible. *)
   27.33 -Goal "|- RPCFail send rcv rst p --> \
   27.34 -\        <RPCNext send rcv rst p>_(rst!p, rtrner send!p, caller rcv!p)";
   27.35 -by (auto_tac (claset() addSDs [Return_changed],
   27.36 -             simpset() addsimps [angle_def,RPCNext_def,RPCFail_def]));
   27.37 -qed "RPCFail_vis";
   27.38 -
   27.39 -Goal "|- Enabled (RPCFail send rcv rst p) --> \
   27.40 -\        Enabled (<RPCNext send rcv rst p>_(rst!p, rtrner send!p, caller rcv!p))";
   27.41 -by (force_tac (mem_css addSEs2 [enabled_mono,RPCFail_vis]) 1);
   27.42 -qed "RPCFail_Next_enabled";
   27.43 -
   27.44 -(* Enabledness of some actions *)
   27.45 -Goal "!!p. basevars (rtrner send!p, caller rcv!p, rst!p) ==> \
   27.46 -\     |- ~Calling rcv p & Calling send p --> Enabled (RPCFail send rcv rst p)";
   27.47 -by (action_simp_tac (simpset() addsimps [RPCFail_def,Return_def,caller_def,rtrner_def])
   27.48 -                    [exI] [base_enabled,Pair_inject] 1);
   27.49 -qed "RPCFail_enabled";
   27.50 -
   27.51 -Goal "!!p. basevars (rtrner send!p, caller rcv!p, rst!p) ==> \
   27.52 -\     |- ~Calling rcv p & Calling send p & rst!p = #rpcB \
   27.53 -\        --> Enabled (RPCReply send rcv rst p)";
   27.54 -by (action_simp_tac (simpset() addsimps [RPCReply_def,Return_def,caller_def,rtrner_def])
   27.55 -                    [exI] [base_enabled,Pair_inject] 1);
   27.56 -qed "RPCReply_enabled";
    28.1 --- a/src/HOL/TLA/Memory/RPC.thy	Fri Dec 01 17:22:33 2006 +0100
    28.2 +++ b/src/HOL/TLA/Memory/RPC.thy	Sat Dec 02 02:52:02 2006 +0100
    28.3 @@ -3,12 +3,9 @@
    28.4      ID:          $Id$
    28.5      Author:      Stephan Merz
    28.6      Copyright:   1997 University of Munich
    28.7 +*)
    28.8  
    28.9 -    Theory Name: RPC
   28.10 -    Logic Image: TLA
   28.11 -
   28.12 -    RPC-Memory example: RPC specification
   28.13 -*)
   28.14 +header {* RPC-Memory example: RPC specification *}
   28.15  
   28.16  theory RPC
   28.17  imports RPCParameters ProcedureInterface Memory
   28.18 @@ -77,6 +74,44 @@
   28.19  
   28.20    RPCISpec_def:      "RPCISpec send rcv rst == TEMP (ALL p. RPCIPSpec send rcv rst p)"
   28.21  
   28.22 -ML {* use_legacy_bindings (the_context ()) *}
   28.23 +
   28.24 +lemmas RPC_action_defs =
   28.25 +  RPCInit_def RPCFwd_def RPCReject_def RPCFail_def RPCReply_def RPCNext_def
   28.26 +
   28.27 +lemmas RPC_temp_defs = RPCIPSpec_def RPCISpec_def
   28.28 +
   28.29 +
   28.30 +(* The RPC component engages in an action for process p only if there is an outstanding,
   28.31 +   unanswered call for that process.
   28.32 +*)
   28.33 +
   28.34 +lemma RPCidle: "|- ~$(Calling send p) --> ~RPCNext send rcv rst p"
   28.35 +  by (auto simp: Return_def RPC_action_defs)
   28.36 +
   28.37 +lemma RPCbusy: "|- $(Calling rcv p) & $(rst!p) = #rpcB --> ~RPCNext send rcv rst p"
   28.38 +  by (auto simp: RPC_action_defs)
   28.39 +
   28.40 +(* RPC failure actions are visible. *)
   28.41 +lemma RPCFail_vis: "|- RPCFail send rcv rst p -->  
   28.42 +    <RPCNext send rcv rst p>_(rst!p, rtrner send!p, caller rcv!p)"
   28.43 +  by (auto dest!: Return_changed [temp_use] simp: angle_def RPCNext_def RPCFail_def)
   28.44 +
   28.45 +lemma RPCFail_Next_enabled: "|- Enabled (RPCFail send rcv rst p) -->  
   28.46 +    Enabled (<RPCNext send rcv rst p>_(rst!p, rtrner send!p, caller rcv!p))"
   28.47 +  by (force elim!: enabled_mono [temp_use] RPCFail_vis [temp_use])
   28.48 +
   28.49 +(* Enabledness of some actions *)
   28.50 +lemma RPCFail_enabled: "!!p. basevars (rtrner send!p, caller rcv!p, rst!p) ==>  
   28.51 +    |- ~Calling rcv p & Calling send p --> Enabled (RPCFail send rcv rst p)"
   28.52 +  by (tactic {* action_simp_tac (simpset () addsimps [thm "RPCFail_def",
   28.53 +    thm "Return_def", thm "caller_def", thm "rtrner_def"]) [exI]
   28.54 +    [thm "base_enabled", thm "Pair_inject"] 1 *})
   28.55 +
   28.56 +lemma RPCReply_enabled: "!!p. basevars (rtrner send!p, caller rcv!p, rst!p) ==>  
   28.57 +      |- ~Calling rcv p & Calling send p & rst!p = #rpcB  
   28.58 +         --> Enabled (RPCReply send rcv rst p)"
   28.59 +  by (tactic {* action_simp_tac (simpset () addsimps [thm "RPCReply_def",
   28.60 +    thm "Return_def", thm "caller_def", thm "rtrner_def"]) [exI]
   28.61 +    [thm "base_enabled", thm "Pair_inject"] 1 *})
   28.62  
   28.63  end
    29.1 --- a/src/HOL/TLA/Memory/RPCMemoryParams.thy	Fri Dec 01 17:22:33 2006 +0100
    29.2 +++ b/src/HOL/TLA/Memory/RPCMemoryParams.thy	Sat Dec 02 02:52:02 2006 +0100
    29.3 @@ -3,12 +3,9 @@
    29.4      ID:          $Id$
    29.5      Author:      Stephan Merz
    29.6      Copyright:   1997 University of Munich
    29.7 +*)
    29.8  
    29.9 -    Theory Name: RPCMemoryParams
   29.10 -    Logic Image: TLA
   29.11 -
   29.12 -    Basic declarations for the RPC-memory example.
   29.13 -*)
   29.14 +header {* Basic declarations for the RPC-memory example *}
   29.15  
   29.16  theory RPCMemoryParams
   29.17  imports Main
    30.1 --- a/src/HOL/TLA/Memory/RPCParameters.ML	Fri Dec 01 17:22:33 2006 +0100
    30.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    30.3 @@ -1,11 +0,0 @@
    30.4 -(*
    30.5 -    File:        RPCParameters.ML
    30.6 -    ID:          $Id$
    30.7 -    Author:      Stephan Merz
    30.8 -    Copyright:   1997 University of Munich
    30.9 -
   30.10 -    RPC-Memory example: RPC parameters (theorems and proofs)
   30.11 -*)
   30.12 -
   30.13 -Addsimps ([RFNoMemVal, NotAResultNotRF, OKNotRF, BANotRF]
   30.14 -          @ (map (fn x => x RS not_sym) [NotAResultNotRF, OKNotRF, BANotRF]));
    31.1 --- a/src/HOL/TLA/Memory/RPCParameters.thy	Fri Dec 01 17:22:33 2006 +0100
    31.2 +++ b/src/HOL/TLA/Memory/RPCParameters.thy	Sat Dec 02 02:52:02 2006 +0100
    31.3 @@ -3,19 +3,19 @@
    31.4      ID:          $Id$
    31.5      Author:      Stephan Merz
    31.6      Copyright:   1997 University of Munich
    31.7 -
    31.8 -    Theory Name: RPCParameters
    31.9 -    Logic Image: TLA
   31.10 +*)
   31.11  
   31.12 -    RPC-Memory example: RPC parameters
   31.13 -    For simplicity, specify the instance of RPC that is used in the
   31.14 -    memory implementation.
   31.15 -*)
   31.16 +header {* RPC-Memory example: RPC parameters *}
   31.17  
   31.18  theory RPCParameters
   31.19  imports MemoryParameters
   31.20  begin
   31.21  
   31.22 +(*
   31.23 +  For simplicity, specify the instance of RPC that is used in the
   31.24 +  memory implementation.
   31.25 +*)
   31.26 +
   31.27  datatype rpcOp = memcall memOp | othercall Vals
   31.28  datatype rpcState = rpcA | rpcB
   31.29  
   31.30 @@ -46,6 +46,7 @@
   31.31  		         case ra of (memcall m) => m
   31.32  		                  | (othercall v) => arbitrary"
   31.33  
   31.34 -ML {* use_legacy_bindings (the_context ()) *}
   31.35 +lemmas [simp] = RFNoMemVal NotAResultNotRF OKNotRF BANotRF
   31.36 +  NotAResultNotRF [symmetric] OKNotRF [symmetric] BANotRF [symmetric]
   31.37  
   31.38  end
    32.1 --- a/src/HOL/TLA/Stfun.ML	Fri Dec 01 17:22:33 2006 +0100
    32.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    32.3 @@ -1,59 +0,0 @@
    32.4 -(*
    32.5 -    File:        Stfun.ML
    32.6 -    ID:          $Id$
    32.7 -    Author:      Stephan Merz
    32.8 -    Copyright:   1998 University of Munich
    32.9 -
   32.10 -Lemmas and tactics for states and state functions.
   32.11 -*)
   32.12 -
   32.13 -Goalw [basevars_def] "!!vs. basevars vs ==> EX u. vs u = c";
   32.14 -by (res_inst_tac [("b","c"),("f","vs")] rangeE 1);
   32.15 -by Auto_tac;
   32.16 -qed "basevars";
   32.17 -
   32.18 -Goal "!!x y. basevars (x,y) ==> basevars x";
   32.19 -by (simp_tac (simpset() addsimps [basevars_def]) 1);
   32.20 -by (rtac equalityI 1);
   32.21 - by (rtac subset_UNIV 1);
   32.22 -by (rtac subsetI 1);
   32.23 -by (dres_inst_tac [("c", "(xa, arbitrary)")] basevars 1);
   32.24 -by Auto_tac;
   32.25 -qed "base_pair1";
   32.26 -
   32.27 -Goal "!!x y. basevars (x,y) ==> basevars y";
   32.28 -by (simp_tac (simpset() addsimps [basevars_def]) 1);
   32.29 -by (rtac equalityI 1);
   32.30 - by (rtac subset_UNIV 1);
   32.31 -by (rtac subsetI 1);
   32.32 -by (dres_inst_tac [("c", "(arbitrary, xa)")] basevars 1);
   32.33 -by Auto_tac;
   32.34 -qed "base_pair2";
   32.35 -
   32.36 -Goal "!!x y. basevars (x,y) ==> basevars x & basevars y";
   32.37 -by (rtac conjI 1);
   32.38 -by (etac base_pair1 1);
   32.39 -by (etac base_pair2 1);
   32.40 -qed "base_pair";
   32.41 -
   32.42 -(* Since the unit type has just one value, any state function can be
   32.43 -   regarded as "base". The following axiom can sometimes be useful
   32.44 -   because it gives a trivial solution for "basevars" premises.
   32.45 -*)
   32.46 -Goalw [basevars_def] "basevars (v::unit stfun)";
   32.47 -by Auto_tac;
   32.48 -qed "unit_base";
   32.49 -
   32.50 -(*  [| basevars v; !!x. v x = c ==> Q |] ==> Q  *)
   32.51 -bind_thm("baseE", (standard (basevars RS exE)));
   32.52 -
   32.53 -(* -------------------------------------------------------------------------------
   32.54 -   The following shows that there should not be duplicates in a "stvars" tuple:
   32.55 -
   32.56 -Goal "!!v. basevars (v::bool stfun, v) ==> False";
   32.57 -by (etac baseE 1);
   32.58 -by (subgoal_tac "(LIFT (v,v)) x = (True, False)" 1);
   32.59 -by (atac 2);
   32.60 -by (Asm_full_simp_tac 1);
   32.61 -
   32.62 -------------------------------------------------------------------------------- *)
    33.1 --- a/src/HOL/TLA/Stfun.thy	Fri Dec 01 17:22:33 2006 +0100
    33.2 +++ b/src/HOL/TLA/Stfun.thy	Sat Dec 02 02:52:02 2006 +0100
    33.3 @@ -3,12 +3,9 @@
    33.4      ID:          $Id$
    33.5      Author:      Stephan Merz
    33.6      Copyright:   1998 University of Munich
    33.7 +*)
    33.8  
    33.9 -    Theory Name: Stfun
   33.10 -    Logic Image: HOL
   33.11 -
   33.12 -States and state functions for TLA as an "intensional" logic.
   33.13 -*)
   33.14 +header {* States and state functions for TLA as an "intensional" logic *}
   33.15  
   33.16  theory Stfun
   33.17  imports Intensional
   33.18 @@ -56,6 +53,62 @@
   33.19    *)
   33.20    basevars_def:  "stvars vs == range vs = UNIV"
   33.21  
   33.22 -ML {* use_legacy_bindings (the_context ()) *}
   33.23 +
   33.24 +lemma basevars: "!!vs. basevars vs ==> EX u. vs u = c"
   33.25 +  apply (unfold basevars_def)
   33.26 +  apply (rule_tac b = c and f = vs in rangeE)
   33.27 +   apply auto
   33.28 +  done
   33.29 +
   33.30 +lemma base_pair1: "!!x y. basevars (x,y) ==> basevars x"
   33.31 +  apply (simp (no_asm) add: basevars_def)
   33.32 +  apply (rule equalityI)
   33.33 +   apply (rule subset_UNIV)
   33.34 +  apply (rule subsetI)
   33.35 +  apply (drule_tac c = "(xa, arbitrary) " in basevars)
   33.36 +  apply auto
   33.37 +  done
   33.38 +
   33.39 +lemma base_pair2: "!!x y. basevars (x,y) ==> basevars y"
   33.40 +  apply (simp (no_asm) add: basevars_def)
   33.41 +  apply (rule equalityI)
   33.42 +   apply (rule subset_UNIV)
   33.43 +  apply (rule subsetI)
   33.44 +  apply (drule_tac c = "(arbitrary, xa) " in basevars)
   33.45 +  apply auto
   33.46 +  done
   33.47 +
   33.48 +lemma base_pair: "!!x y. basevars (x,y) ==> basevars x & basevars y"
   33.49 +  apply (rule conjI)
   33.50 +  apply (erule base_pair1)
   33.51 +  apply (erule base_pair2)
   33.52 +  done
   33.53 +
   33.54 +(* Since the unit type has just one value, any state function can be
   33.55 +   regarded as "base". The following axiom can sometimes be useful
   33.56 +   because it gives a trivial solution for "basevars" premises.
   33.57 +*)
   33.58 +lemma unit_base: "basevars (v::unit stfun)"
   33.59 +  apply (unfold basevars_def)
   33.60 +  apply auto
   33.61 +  done
   33.62 +
   33.63 +lemma baseE: "[| basevars v; !!x. v x = c ==> Q |] ==> Q"
   33.64 +  apply (erule basevars [THEN exE])
   33.65 +  apply blast
   33.66 +  done
   33.67 +
   33.68 +
   33.69 +(* -------------------------------------------------------------------------------
   33.70 +   The following shows that there should not be duplicates in a "stvars" tuple:
   33.71 +*)
   33.72 +
   33.73 +lemma "!!v. basevars (v::bool stfun, v) ==> False"
   33.74 +  apply (erule baseE)
   33.75 +  apply (subgoal_tac "(LIFT (v,v)) x = (True, False)")
   33.76 +   prefer 2
   33.77 +   apply assumption
   33.78 +  apply simp
   33.79 +  done
   33.80  
   33.81  end
    34.1 --- a/src/HOL/TLA/TLA.ML	Fri Dec 01 17:22:33 2006 +0100
    34.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    34.3 @@ -1,1069 +0,0 @@
    34.4 -(*
    34.5 -    File:        TLA/TLA.ML
    34.6 -    ID:          $Id$
    34.7 -    Author:      Stephan Merz
    34.8 -    Copyright:   1998 University of Munich
    34.9 -
   34.10 -Lemmas and tactics for temporal reasoning.
   34.11 -*)
   34.12 -
   34.13 -(* Specialize intensional introduction/elimination rules for temporal formulas *)
   34.14 -
   34.15 -val [prem] = goal (the_context ()) "(!!sigma. sigma |= (F::temporal)) ==> |- F";
   34.16 -by (REPEAT (resolve_tac [prem,intI] 1));
   34.17 -qed "tempI";
   34.18 -
   34.19 -val [prem] = goal (the_context ()) "|- (F::temporal) ==> sigma |= F";
   34.20 -by (rtac (prem RS intD) 1);
   34.21 -qed "tempD";
   34.22 -
   34.23 -
   34.24 -(* ======== Functions to "unlift" temporal theorems ====== *)
   34.25 -
   34.26 -(* The following functions are specialized versions of the corresponding
   34.27 -   functions defined in Intensional.ML in that they introduce a
   34.28 -   "world" parameter of type "behavior".
   34.29 -*)
   34.30 -fun temp_unlift th =
   34.31 -    (rewrite_rule action_rews (th RS tempD))
   34.32 -    handle _ => action_unlift th;
   34.33 -
   34.34 -(* Turn  |- F = G  into meta-level rewrite rule  F == G *)
   34.35 -val temp_rewrite = int_rewrite;
   34.36 -
   34.37 -fun temp_use th =
   34.38 -    case (concl_of th) of
   34.39 -      Const _ $ (Const ("Intensional.Valid", _) $ _) =>
   34.40 -              ((flatten (temp_unlift th)) handle _ => th)
   34.41 -    | _ => th;
   34.42 -
   34.43 -(* Update classical reasoner---will be updated once more below! *)
   34.44 -
   34.45 -AddSIs [tempI];
   34.46 -AddDs [tempD];
   34.47 -
   34.48 -val temp_css = (claset(), simpset());
   34.49 -val temp_cs = op addss temp_css;
   34.50 -
   34.51 -(* Modify the functions that add rules to simpsets, classical sets,
   34.52 -   and clasimpsets in order to accept "lifted" theorems
   34.53 -*)
   34.54 -
   34.55 -local
   34.56 -  fun try_rewrite th =
   34.57 -      (temp_rewrite th) handle _ => temp_use th
   34.58 -in
   34.59 -  val op addsimps = fn (ss, ts) => ss addsimps (map try_rewrite ts)
   34.60 -  val op addsimps2 = fn (css, ts) => css addsimps2 (map try_rewrite ts)
   34.61 -end;
   34.62 -
   34.63 -val op addSIs = fn (cs, ts) => cs addSIs (map temp_use ts);
   34.64 -val op addSEs = fn (cs, ts) => cs addSEs (map temp_use ts);
   34.65 -val op addSDs = fn (cs, ts) => cs addSDs (map temp_use ts);
   34.66 -val op addIs = fn (cs, ts) => cs addIs (map temp_use ts);
   34.67 -val op addEs = fn (cs, ts) => cs addEs (map temp_use ts);
   34.68 -val op addDs = fn (cs, ts) => cs addDs (map temp_use ts);
   34.69 -
   34.70 -val op addSIs2 = fn (css, ts) => css addSIs2 (map temp_use ts);
   34.71 -val op addSEs2 = fn (css, ts) => css addSEs2 (map temp_use ts);
   34.72 -val op addSDs2 = fn (css, ts) => css addSDs2 (map temp_use ts);
   34.73 -val op addIs2 = fn (css, ts) => css addIs2 (map temp_use ts);
   34.74 -val op addEs2 = fn (css, ts) => css addEs2 (map temp_use ts);
   34.75 -val op addDs2 = fn (css, ts) => css addDs2 (map temp_use ts);
   34.76 -
   34.77 -
   34.78 -(* ------------------------------------------------------------------------- *)
   34.79 -(***           "Simple temporal logic": only [] and <>                     ***)
   34.80 -(* ------------------------------------------------------------------------- *)
   34.81 -section "Simple temporal logic";
   34.82 -
   34.83 -(* []~F == []~Init F *)
   34.84 -bind_thm("boxNotInit",
   34.85 -         rewrite_rule Init_simps (read_instantiate [("F", "LIFT ~F")] boxInit));
   34.86 -
   34.87 -Goalw [dmd_def] "TEMP <>F == TEMP <> Init F";
   34.88 -by (rewtac (read_instantiate [("F", "LIFT ~F")] boxInit));
   34.89 -by (simp_tac (simpset() addsimps Init_simps) 1);
   34.90 -qed "dmdInit";
   34.91 -
   34.92 -bind_thm("dmdNotInit",
   34.93 -         rewrite_rule Init_simps (read_instantiate [("F", "LIFT ~F")] dmdInit));
   34.94 -
   34.95 -(* boxInit and dmdInit cannot be used as rewrites, because they loop.
   34.96 -   Non-looping instances for state predicates and actions are occasionally useful.
   34.97 -*)
   34.98 -bind_thm("boxInit_stp", read_instantiate [("'a","state")] boxInit);
   34.99 -bind_thm("boxInit_act", read_instantiate [("'a","state * state")] boxInit);
  34.100 -bind_thm("dmdInit_stp", read_instantiate [("'a","state")] dmdInit);
  34.101 -bind_thm("dmdInit_act", read_instantiate [("'a","state * state")] dmdInit);
  34.102 -
  34.103 -(* The symmetric equations can be used to get rid of Init *)
  34.104 -bind_thm("boxInitD", symmetric boxInit);
  34.105 -bind_thm("dmdInitD", symmetric dmdInit);
  34.106 -bind_thm("boxNotInitD", symmetric boxNotInit);
  34.107 -bind_thm("dmdNotInitD", symmetric dmdNotInit);
  34.108 -
  34.109 -val Init_simps = Init_simps @ [boxInitD, dmdInitD, boxNotInitD, dmdNotInitD];
  34.110 -
  34.111 -(* ------------------------ STL2 ------------------------------------------- *)
  34.112 -bind_thm("STL2", reflT);
  34.113 -
  34.114 -(* The "polymorphic" (generic) variant *)
  34.115 -Goal "|- []F --> Init F";
  34.116 -by (rewtac (read_instantiate [("F", "F")] boxInit));
  34.117 -by (rtac STL2 1);
  34.118 -qed "STL2_gen";
  34.119 -
  34.120 -(* see also STL2_pr below: "|- []P --> Init P & Init (P`)" *)
  34.121 -
  34.122 -
  34.123 -(* Dual versions for <> *)
  34.124 -Goalw [dmd_def] "|- F --> <> F";
  34.125 -by (auto_tac (temp_css addSDs2 [STL2]));
  34.126 -qed "InitDmd";
  34.127 -
  34.128 -Goal "|- Init F --> <>F";
  34.129 -by (Clarsimp_tac 1);
  34.130 -by (dtac (temp_use InitDmd) 1);
  34.131 -by (asm_full_simp_tac (simpset() addsimps [dmdInitD]) 1);
  34.132 -qed "InitDmd_gen";
  34.133 -
  34.134 -
  34.135 -(* ------------------------ STL3 ------------------------------------------- *)
  34.136 -Goal "|- ([][]F) = ([]F)";
  34.137 -by (force_tac (temp_css addEs2 [transT,STL2]) 1);
  34.138 -qed "STL3";
  34.139 -
  34.140 -(* corresponding elimination rule introduces double boxes:
  34.141 -   [| (sigma |= []F); (sigma |= [][]F) ==> PROP W |] ==> PROP W
  34.142 -*)
  34.143 -bind_thm("dup_boxE", make_elim((temp_unlift STL3) RS iffD2));
  34.144 -bind_thm("dup_boxD", (temp_unlift STL3) RS iffD1);
  34.145 -
  34.146 -(* dual versions for <> *)
  34.147 -Goal "|- (<><>F) = (<>F)";
  34.148 -by (auto_tac (temp_css addsimps2 [dmd_def,STL3]));
  34.149 -qed "DmdDmd";
  34.150 -bind_thm("dup_dmdE", make_elim((temp_unlift DmdDmd) RS iffD2));
  34.151 -bind_thm("dup_dmdD", (temp_unlift DmdDmd) RS iffD1);
  34.152 -
  34.153 -
  34.154 -(* ------------------------ STL4 ------------------------------------------- *)
  34.155 -val [prem] = goal (the_context ()) "|- F --> G  ==> |- []F --> []G";
  34.156 -by (Clarsimp_tac 1);
  34.157 -by (rtac (temp_use normalT) 1);
  34.158 -by (rtac (temp_use (prem RS necT)) 1);
  34.159 -by (atac 1);
  34.160 -qed "STL4";
  34.161 -
  34.162 -(* Unlifted version as an elimination rule *)
  34.163 -val prems = goal (the_context ()) "[| sigma |= []F; |- F --> G |] ==> sigma |= []G";
  34.164 -by (REPEAT (resolve_tac (prems @ [temp_use STL4]) 1));
  34.165 -qed "STL4E";
  34.166 -
  34.167 -val [prem] = goal (the_context ()) "|- Init F --> Init G ==> |- []F --> []G";
  34.168 -by (rtac (rewrite_rule [boxInitD] (prem RS STL4)) 1);
  34.169 -qed "STL4_gen";
  34.170 -
  34.171 -val prems = goal (the_context ())
  34.172 -   "[| sigma |= []F; |- Init F --> Init G |] ==> sigma |= []G";
  34.173 -by (REPEAT (resolve_tac (prems @ [temp_use STL4_gen]) 1));
  34.174 -qed "STL4E_gen";
  34.175 -
  34.176 -(* see also STL4Edup below, which allows an auxiliary boxed formula:
  34.177 -       []A /\ F => G
  34.178 -     -----------------
  34.179 -     []A /\ []F => []G
  34.180 -*)
  34.181 -
  34.182 -(* The dual versions for <> *)
  34.183 -val [prem] = goalw (the_context ()) [dmd_def]
  34.184 -   "|- F --> G ==> |- <>F --> <>G";
  34.185 -by (fast_tac (temp_cs addSIs [prem] addSEs [STL4E]) 1);
  34.186 -qed "DmdImpl";
  34.187 -
  34.188 -val prems = goal (the_context ()) "[| sigma |= <>F; |- F --> G |] ==> sigma |= <>G";
  34.189 -by (REPEAT (resolve_tac (prems @ [temp_use DmdImpl]) 1));
  34.190 -qed "DmdImplE";
  34.191 -
  34.192 -
  34.193 -(* ------------------------ STL5 ------------------------------------------- *)
  34.194 -Goal "|- ([]F & []G) = ([](F & G))";
  34.195 -by Auto_tac;
  34.196 -by (subgoal_tac "sigma |= [](G --> (F & G))" 1);
  34.197 -by (etac (temp_use normalT) 1);
  34.198 -by (ALLGOALS (fast_tac (temp_cs addSEs [STL4E])));
  34.199 -qed "STL5";
  34.200 -
  34.201 -(* rewrite rule to split conjunctions under boxes *)
  34.202 -bind_thm("split_box_conj", (temp_unlift STL5) RS sym);
  34.203 -
  34.204 -(* the corresponding elimination rule allows to combine boxes in the hypotheses
  34.205 -   (NB: F and G must have the same type, i.e., both actions or temporals.)
  34.206 -   Use "addSE2" etc. if you want to add this to a claset, otherwise it will loop!
  34.207 -*)
  34.208 -val prems = goal (the_context ())
  34.209 -   "[| sigma |= []F; sigma |= []G; sigma |= [](F&G) ==> PROP R |] ==> PROP R";
  34.210 -by (REPEAT (resolve_tac (prems @ [(temp_unlift STL5) RS iffD1, conjI]) 1));
  34.211 -qed "box_conjE";
  34.212 -
  34.213 -(* Instances of box_conjE for state predicates, actions, and temporals
  34.214 -   in case the general rule is "too polymorphic".
  34.215 -*)
  34.216 -bind_thm("box_conjE_temp", read_instantiate [("'a","behavior")] box_conjE);
  34.217 -bind_thm("box_conjE_stp", read_instantiate [("'a","state")] box_conjE);
  34.218 -bind_thm("box_conjE_act", read_instantiate [("'a","state * state")] box_conjE);
  34.219 -
  34.220 -(* Define a tactic that tries to merge all boxes in an antecedent. The definition is
  34.221 -   a bit kludgy in order to simulate "double elim-resolution".
  34.222 -*)
  34.223 -
  34.224 -Goal "[| sigma |= []F; PROP W |] ==> PROP W";
  34.225 -by (atac 1);
  34.226 -val box_thin = result();
  34.227 -
  34.228 -fun merge_box_tac i =
  34.229 -   REPEAT_DETERM (EVERY [etac box_conjE i, atac i, etac box_thin i]);
  34.230 -
  34.231 -fun merge_temp_box_tac i =
  34.232 -   REPEAT_DETERM (EVERY [etac box_conjE_temp i, atac i,
  34.233 -                         eres_inst_tac [("'a","behavior")] box_thin i]);
  34.234 -
  34.235 -fun merge_stp_box_tac i =
  34.236 -   REPEAT_DETERM (EVERY [etac box_conjE_stp i, atac i,
  34.237 -                         eres_inst_tac [("'a","state")] box_thin i]);
  34.238 -
  34.239 -fun merge_act_box_tac i =
  34.240 -   REPEAT_DETERM (EVERY [etac box_conjE_act i, atac i,
  34.241 -                         eres_inst_tac [("'a","state * state")] box_thin i]);
  34.242 -
  34.243 -
  34.244 -(* rewrite rule to push universal quantification through box:
  34.245 -      (sigma |= [](! x. F x)) = (! x. (sigma |= []F x))
  34.246 -*)
  34.247 -bind_thm("all_box", standard((temp_unlift allT) RS sym));
  34.248 -
  34.249 -bind_thm ("contrapos_np", thm "contrapos_np");
  34.250 -
  34.251 -Goal "|- (<>(F | G)) = (<>F | <>G)";
  34.252 -by (auto_tac (temp_css addsimps2 [dmd_def,split_box_conj]));
  34.253 -by (ALLGOALS (EVERY' [etac contrapos_np,
  34.254 -                      merge_box_tac,
  34.255 -                      fast_tac (temp_cs addSEs [STL4E])]));
  34.256 -qed "DmdOr";
  34.257 -
  34.258 -Goal "|- (EX x. <>(F x)) = (<>(EX x. F x))";
  34.259 -by (auto_tac (temp_css addsimps2 [dmd_def,Not_Rex,all_box]));
  34.260 -qed "exT";
  34.261 -
  34.262 -bind_thm("ex_dmd", standard((temp_unlift exT) RS sym));
  34.263 -
  34.264 -
  34.265 -Goal "!!sigma. [| sigma |= []A; sigma |= []F; |- F & []A --> G |] ==> sigma |= []G";
  34.266 -by (etac dup_boxE 1);
  34.267 -by (merge_box_tac 1);
  34.268 -by (etac STL4E 1);
  34.269 -by (atac 1);
  34.270 -qed "STL4Edup";
  34.271 -
  34.272 -Goalw [dmd_def]
  34.273 -   "!!sigma. [| sigma |= <>F; sigma |= [](F --> G) |] ==> sigma |= <>G";
  34.274 -by Auto_tac;
  34.275 -by (etac notE 1);
  34.276 -by (merge_box_tac 1);
  34.277 -by (fast_tac (temp_cs addSEs [STL4E]) 1);
  34.278 -qed "DmdImpl2";
  34.279 -
  34.280 -val [prem1,prem2,prem3] = goal (the_context ())
  34.281 -  "[| sigma |= []<>F; sigma |= []G; |- F & G --> H |] ==> sigma |= []<>H";
  34.282 -by (cut_facts_tac [prem1,prem2] 1);
  34.283 -by (eres_inst_tac [("F","G")] dup_boxE 1);
  34.284 -by (merge_box_tac 1);
  34.285 -by (fast_tac (temp_cs addSEs [STL4E,DmdImpl2] addSIs [prem3]) 1);
  34.286 -qed "InfImpl";
  34.287 -
  34.288 -(* ------------------------ STL6 ------------------------------------------- *)
  34.289 -(* Used in the proof of STL6, but useful in itself. *)
  34.290 -Goalw [dmd_def] "|- []F & <>G --> <>([]F & G)";
  34.291 -by (Clarsimp_tac 1);
  34.292 -by (etac dup_boxE 1);
  34.293 -by (merge_box_tac 1);
  34.294 -by (etac contrapos_np 1);
  34.295 -by (fast_tac (temp_cs addSEs [STL4E]) 1);
  34.296 -qed "BoxDmd";
  34.297 -
  34.298 -(* weaker than BoxDmd, but more polymorphic (and often just right) *)
  34.299 -Goalw [dmd_def] "|- []F & <>G --> <>(F & G)";
  34.300 -by (Clarsimp_tac 1);
  34.301 -by (merge_box_tac 1);
  34.302 -by (fast_tac (temp_cs addSEs [notE,STL4E]) 1);
  34.303 -qed "BoxDmd_simple";
  34.304 -
  34.305 -Goalw [dmd_def] "|- []F & <>G --> <>(G & F)";
  34.306 -by (Clarsimp_tac 1);
  34.307 -by (merge_box_tac 1);
  34.308 -by (fast_tac (temp_cs addSEs [notE,STL4E]) 1);
  34.309 -qed "BoxDmd2_simple";
  34.310 -
  34.311 -val [p1,p2,p3] = goal (the_context ())
  34.312 -   "[| sigma |= []A; sigma |= <>F; |- []A & F --> G |] ==> sigma |= <>G";
  34.313 -by (rtac ((p2 RS (p1 RS (temp_use BoxDmd))) RS DmdImplE) 1);
  34.314 -by (rtac p3 1);
  34.315 -qed "DmdImpldup";
  34.316 -
  34.317 -Goal "|- <>[]F & <>[]G --> <>[](F & G)";
  34.318 -by (auto_tac (temp_css addsimps2 [symmetric (temp_rewrite STL5)]));
  34.319 -by (dtac (temp_use linT) 1);
  34.320 -by (atac 1);
  34.321 -by (etac thin_rl 1);
  34.322 -by (rtac ((temp_unlift DmdDmd) RS iffD1) 1);
  34.323 -by (etac disjE 1);
  34.324 -by (etac DmdImplE 1);
  34.325 -by (rtac BoxDmd 1);
  34.326 -by (etac DmdImplE 1);
  34.327 -by Auto_tac;
  34.328 -by (dtac (temp_use BoxDmd) 1);
  34.329 -by (atac 1);
  34.330 -by (etac thin_rl 1);
  34.331 -by (fast_tac (temp_cs addSEs [DmdImplE]) 1);
  34.332 -qed "STL6";
  34.333 -
  34.334 -
  34.335 -(* ------------------------ True / False ----------------------------------------- *)
  34.336 -section "Simplification of constants";
  34.337 -
  34.338 -Goal "|- ([]#P) = #P";
  34.339 -by (rtac tempI 1);
  34.340 -by (case_tac "P" 1);
  34.341 -by (auto_tac (temp_css addSIs2 [necT] addDs2 [STL2_gen]
  34.342 -                       addsimps2 Init_simps));
  34.343 -qed "BoxConst";
  34.344 -
  34.345 -Goalw [dmd_def] "|- (<>#P) = #P";
  34.346 -by (case_tac "P" 1);
  34.347 -by (ALLGOALS (asm_full_simp_tac (simpset() addsimps [BoxConst])));
  34.348 -qed "DmdConst";
  34.349 -
  34.350 -val temp_simps = map temp_rewrite [BoxConst, DmdConst];
  34.351 -
  34.352 -(* Make these rewrites active by default *)
  34.353 -Addsimps temp_simps;
  34.354 -val temp_css = temp_css addsimps2 temp_simps;
  34.355 -val temp_cs = op addss temp_css;
  34.356 -
  34.357 -
  34.358 -(* ------------------------ Further rewrites ----------------------------------------- *)
  34.359 -section "Further rewrites";
  34.360 -
  34.361 -Goalw [dmd_def] "|- (~[]F) = (<>~F)";
  34.362 -by (Simp_tac 1);
  34.363 -qed "NotBox";
  34.364 -
  34.365 -Goalw [dmd_def] "|- (~<>F) = ([]~F)";
  34.366 -by (Simp_tac 1);
  34.367 -qed "NotDmd";
  34.368 -
  34.369 -(* These are not by default included in temp_css, because they could be harmful,
  34.370 -   e.g. []F & ~[]F becomes []F & <>~F !! *)
  34.371 -val more_temp_simps =  (map temp_rewrite [STL3, DmdDmd, NotBox, NotDmd])
  34.372 -                       @ (map (fn th => (temp_unlift th) RS eq_reflection)
  34.373 -                         [NotBox, NotDmd]);
  34.374 -
  34.375 -Goal "|- ([]<>[]F) = (<>[]F)";
  34.376 -by (auto_tac (temp_css addSDs2 [STL2]));
  34.377 -by (rtac ccontr 1);
  34.378 -by (subgoal_tac "sigma |= <>[][]F & <>[]~[]F" 1);
  34.379 -by (etac thin_rl 1);
  34.380 -by Auto_tac;
  34.381 -by (dtac (temp_use STL6) 1);
  34.382 -by (atac 1);
  34.383 -by (Asm_full_simp_tac 1);
  34.384 -by (ALLGOALS (asm_full_simp_tac (simpset() addsimps more_temp_simps)));
  34.385 -qed "BoxDmdBox";
  34.386 -
  34.387 -Goalw [dmd_def] "|- (<>[]<>F) = ([]<>F)";
  34.388 -by (auto_tac (temp_css addsimps2 [rewrite_rule [dmd_def] BoxDmdBox]));
  34.389 -qed "DmdBoxDmd";
  34.390 -
  34.391 -val more_temp_simps = more_temp_simps @ (map temp_rewrite [BoxDmdBox, DmdBoxDmd]);
  34.392 -
  34.393 -
  34.394 -(* ------------------------ Miscellaneous ----------------------------------- *)
  34.395 -
  34.396 -Goal "!!sigma. [| sigma |= []F | []G |] ==> sigma |= [](F | G)";
  34.397 -by (fast_tac (temp_cs addSEs [STL4E]) 1);
  34.398 -qed "BoxOr";
  34.399 -
  34.400 -(* "persistently implies infinitely often" *)
  34.401 -Goal "|- <>[]F --> []<>F";
  34.402 -by (Clarsimp_tac 1);
  34.403 -by (rtac ccontr 1);
  34.404 -by (asm_full_simp_tac (simpset() addsimps more_temp_simps) 1);
  34.405 -by (dtac (temp_use STL6) 1);
  34.406 -by (atac 1);
  34.407 -by (Asm_full_simp_tac 1);
  34.408 -qed "DBImplBD";
  34.409 -
  34.410 -Goal "|- []<>F & <>[]G --> []<>(F & G)";
  34.411 -by (Clarsimp_tac 1);
  34.412 -by (rtac ccontr 1);
  34.413 -by (rewrite_goals_tac more_temp_simps);
  34.414 -by (dtac (temp_use STL6) 1);
  34.415 -by (atac 1);
  34.416 -by (subgoal_tac "sigma |= <>[]~F" 1);
  34.417 - by (force_tac (temp_css addsimps2 [dmd_def]) 1);
  34.418 -by (fast_tac (temp_cs addEs [DmdImplE,STL4E]) 1);
  34.419 -qed "BoxDmdDmdBox";
  34.420 -
  34.421 -
  34.422 -(* ------------------------------------------------------------------------- *)
  34.423 -(***          TLA-specific theorems: primed formulas                       ***)
  34.424 -(* ------------------------------------------------------------------------- *)
  34.425 -section "priming";
  34.426 -
  34.427 -(* ------------------------ TLA2 ------------------------------------------- *)
  34.428 -Goal "|- []P --> Init P & Init P`";
  34.429 -by (fast_tac (temp_cs addSIs [primeI, STL2_gen]) 1);
  34.430 -qed "STL2_pr";
  34.431 -
  34.432 -(* Auxiliary lemma allows priming of boxed actions *)
  34.433 -Goal "|- []P --> []($P & P$)";
  34.434 -by (Clarsimp_tac 1);
  34.435 -by (etac dup_boxE 1);
  34.436 -by (rewtac boxInit_act);
  34.437 -by (etac STL4E 1);
  34.438 -by (auto_tac (temp_css addsimps2 Init_simps addSDs2 [STL2_pr]));
  34.439 -qed "BoxPrime";
  34.440 -
  34.441 -val prems = goal (the_context ()) "|- $P & P$ --> A  ==>  |- []P --> []A";
  34.442 -by (Clarsimp_tac 1);
  34.443 -by (dtac (temp_use BoxPrime) 1);
  34.444 -by (auto_tac (temp_css addsimps2 [Init_stp_act_rev]
  34.445 -                       addSIs2 prems addSEs2 [STL4E]));
  34.446 -qed "TLA2";
  34.447 -
  34.448 -val prems = goal (the_context ())
  34.449 -  "[| sigma |= []P; |- $P & P$ --> A |] ==> sigma |= []A";
  34.450 -by (REPEAT (resolve_tac (prems @ (prems RL [temp_use TLA2])) 1));
  34.451 -qed "TLA2E";
  34.452 -
  34.453 -Goalw [dmd_def] "|- (<>P`) --> (<>P)";
  34.454 -by (fast_tac (temp_cs addSEs [TLA2E]) 1);
  34.455 -qed "DmdPrime";
  34.456 -
  34.457 -bind_thm("PrimeDmd", (temp_use InitDmd_gen) RS (temp_use DmdPrime));
  34.458 -
  34.459 -(* ------------------------ INV1, stable --------------------------------------- *)
  34.460 -section "stable, invariant";
  34.461 -
  34.462 -val prems = goal (the_context ())
  34.463 -   "[| sigma |= []H; sigma |= Init P; |- H --> (Init P & ~[]F --> Init(P`) & F) |] \
  34.464 -\   ==> sigma |= []F";
  34.465 -by (rtac (temp_use indT) 1);
  34.466 -by (REPEAT (resolve_tac (prems @ (prems RL [STL4E])) 1));
  34.467 -qed "ind_rule";
  34.468 -
  34.469 -Goalw [boxInit_act] "|- ([]$P) = ([]P)";
  34.470 -by (simp_tac (simpset() addsimps Init_simps) 1);
  34.471 -qed "box_stp_act";
  34.472 -bind_thm("box_stp_actI", zero_var_indexes ((temp_use box_stp_act) RS iffD2));
  34.473 -bind_thm("box_stp_actD", zero_var_indexes ((temp_use box_stp_act) RS iffD1));
  34.474 -
  34.475 -val more_temp_simps = (temp_rewrite box_stp_act)::more_temp_simps;
  34.476 -
  34.477 -Goalw [stable_def,boxInit_stp,boxInit_act]
  34.478 -  "|- (Init P) --> (stable P) --> []P";
  34.479 -by (Clarsimp_tac 1);
  34.480 -by (etac ind_rule 1);
  34.481 -by (auto_tac (temp_css addsimps2 Init_simps addEs2 [ind_rule]));
  34.482 -qed "INV1";
  34.483 -
  34.484 -Goalw [stable_def]
  34.485 -   "!!P. |- $P & A --> P` ==> |- []A --> stable P";
  34.486 -by (fast_tac (temp_cs addSEs [STL4E]) 1);
  34.487 -qed "StableT";
  34.488 -
  34.489 -val prems = goal (the_context ())
  34.490 -   "[| sigma |= []A; |- $P & A --> P` |] ==> sigma |= stable P";
  34.491 -by (REPEAT (resolve_tac (prems @ [temp_use StableT]) 1));
  34.492 -qed "Stable";
  34.493 -
  34.494 -(* Generalization of INV1 *)
  34.495 -Goalw [stable_def] "|- (stable P) --> [](Init P --> []P)";
  34.496 -by (Clarsimp_tac 1);
  34.497 -by (etac dup_boxE 1);
  34.498 -by (force_tac (temp_css addsimps2 [stable_def] addEs2 [STL4E, INV1]) 1);
  34.499 -qed "StableBox";
  34.500 -
  34.501 -Goal "|- (stable P) & <>P --> <>[]P";
  34.502 -by (Clarsimp_tac 1);
  34.503 -by (rtac DmdImpl2 1);
  34.504 -by (etac (temp_use StableBox) 2);
  34.505 -by (asm_simp_tac (simpset() addsimps [dmdInitD]) 1);
  34.506 -qed "DmdStable";
  34.507 -
  34.508 -(* ---------------- (Semi-)automatic invariant tactics ---------------------- *)
  34.509 -
  34.510 -(* inv_tac reduces goals of the form ... ==> sigma |= []P *)
  34.511 -fun inv_tac css = SELECT_GOAL
  34.512 -     (EVERY [auto_tac css,
  34.513 -             TRY (merge_box_tac 1),
  34.514 -             rtac (temp_use INV1) 1, (* fail if the goal is not a box *)
  34.515 -             TRYALL (etac Stable)]);
  34.516 -
  34.517 -(* auto_inv_tac applies inv_tac and then tries to attack the subgoals;
  34.518 -   in simple cases it may be able to handle goals like |- MyProg --> []Inv.
  34.519 -   In these simple cases the simplifier seems to be more useful than the
  34.520 -   auto-tactic, which applies too much propositional logic and simplifies
  34.521 -   too late.
  34.522 -*)
  34.523 -
  34.524 -fun auto_inv_tac ss = SELECT_GOAL
  34.525 -    ((inv_tac (claset(),ss) 1) THEN
  34.526 -     (TRYALL (action_simp_tac (ss addsimps [Init_stp,Init_act]) [] [squareE])));
  34.527 -
  34.528 -
  34.529 -Goalw [dmd_def] "|- []($P --> P` | Q`) --> (stable P) | <>Q";
  34.530 -by (clarsimp_tac (temp_css addSDs2 [BoxPrime]) 1);
  34.531 -by (merge_box_tac 1);
  34.532 -by (etac contrapos_np 1);
  34.533 -by (fast_tac (temp_cs addSEs [Stable]) 1);
  34.534 -qed "unless";
  34.535 -
  34.536 -
  34.537 -(* --------------------- Recursive expansions --------------------------------------- *)
  34.538 -section "recursive expansions";
  34.539 -
  34.540 -(* Recursive expansions of [] and <> for state predicates *)
  34.541 -Goal "|- ([]P) = (Init P & []P`)";
  34.542 -by (auto_tac (temp_css addSIs2 [STL2_gen]));
  34.543 -by (fast_tac (temp_cs addSEs [TLA2E]) 1);
  34.544 -by (auto_tac (temp_css addsimps2 [stable_def] addSEs2 [INV1,STL4E]));
  34.545 -qed "BoxRec";
  34.546 -
  34.547 -Goalw [dmd_def, temp_rewrite BoxRec] "|- (<>P) = (Init P | <>P`)";
  34.548 -by (auto_tac (temp_css addsimps2 Init_simps));
  34.549 -qed "DmdRec";
  34.550 -
  34.551 -Goal "!!sigma. [| sigma |= <>P; sigma |= []~P` |] ==> sigma |= Init P";
  34.552 -by (force_tac (temp_css addsimps2 [DmdRec,dmd_def]) 1);
  34.553 -qed "DmdRec2";
  34.554 -
  34.555 -Goal "|- ([]<>P) = ([]<>P`)";
  34.556 -by Auto_tac;
  34.557 -by (rtac classical 1);
  34.558 -by (rtac (temp_use DBImplBD) 1);
  34.559 -by (subgoal_tac "sigma |= <>[]P" 1);
  34.560 - by (fast_tac (temp_cs addSEs [DmdImplE,TLA2E]) 1);
  34.561 - by (subgoal_tac "sigma |= <>[](<>P & []~P`)" 1);
  34.562 -  by (force_tac (temp_css addsimps2 [boxInit_stp]
  34.563 -                          addSEs2 [DmdImplE,STL4E,DmdRec2]) 1);
  34.564 - by (force_tac (temp_css addSIs2 [STL6] addsimps2 more_temp_simps) 1);
  34.565 -by (fast_tac (temp_cs addIs [DmdPrime] addSEs [STL4E]) 1);
  34.566 -qed "InfinitePrime";
  34.567 -
  34.568 -val prems = goalw (the_context ()) [temp_rewrite InfinitePrime]
  34.569 -  "[| sigma |= []N; sigma |= []<>A; |- A & N --> P` |] ==> sigma |= []<>P";
  34.570 -by (rtac InfImpl 1);
  34.571 -by (REPEAT (resolve_tac prems 1));
  34.572 -qed "InfiniteEnsures";
  34.573 -
  34.574 -(* ------------------------ fairness ------------------------------------------- *)
  34.575 -section "fairness";
  34.576 -
  34.577 -(* alternative definitions of fairness *)
  34.578 -Goalw [WF_def,dmd_def]
  34.579 -  "|- WF(A)_v = ([]<>~Enabled(<A>_v) | []<><A>_v)";
  34.580 -by (fast_tac temp_cs 1);
  34.581 -qed "WF_alt";
  34.582 -
  34.583 -Goalw [SF_def,dmd_def]
  34.584 -  "|- SF(A)_v = (<>[]~Enabled(<A>_v) | []<><A>_v)";
  34.585 -by (fast_tac temp_cs 1);
  34.586 -qed "SF_alt";
  34.587 -
  34.588 -(* theorems to "box" fairness conditions *)
  34.589 -Goal "|- WF(A)_v --> []WF(A)_v";
  34.590 -by (auto_tac (temp_css addsimps2 (WF_alt::more_temp_simps)
  34.591 -                       addSIs2 [BoxOr]));
  34.592 -qed "BoxWFI";
  34.593 -
  34.594 -Goal "|- ([]WF(A)_v) = WF(A)_v";
  34.595 -by (fast_tac (temp_cs addSIs [BoxWFI] addSDs [STL2]) 1);
  34.596 -qed "WF_Box";
  34.597 -
  34.598 -Goal "|- SF(A)_v --> []SF(A)_v";
  34.599 -by (auto_tac (temp_css addsimps2 (SF_alt::more_temp_simps)
  34.600 -                       addSIs2 [BoxOr]));
  34.601 -qed "BoxSFI";
  34.602 -
  34.603 -Goal "|- ([]SF(A)_v) = SF(A)_v";
  34.604 -by (fast_tac (temp_cs addSIs [BoxSFI] addSDs [STL2]) 1);
  34.605 -qed "SF_Box";
  34.606 -
  34.607 -val more_temp_simps = more_temp_simps @ (map temp_rewrite [WF_Box, SF_Box]);
  34.608 -
  34.609 -Goalw [SF_def,WF_def] "|- SF(A)_v --> WF(A)_v";
  34.610 -by (fast_tac (temp_cs addSDs [DBImplBD]) 1);
  34.611 -qed "SFImplWF";
  34.612 -
  34.613 -(* A tactic that "boxes" all fairness conditions. Apply more_temp_simps to "unbox". *)
  34.614 -val box_fair_tac = SELECT_GOAL (REPEAT (dresolve_tac [BoxWFI,BoxSFI] 1));
  34.615 -
  34.616 -
  34.617 -(* ------------------------------ leads-to ------------------------------ *)
  34.618 -
  34.619 -section "~>";
  34.620 -
  34.621 -Goalw  [leadsto_def] "|- (Init F) & (F ~> G) --> <>G";
  34.622 -by (auto_tac (temp_css addSDs2 [STL2]));
  34.623 -qed "leadsto_init";
  34.624 -
  34.625 -(* |- F & (F ~> G) --> <>G *)
  34.626 -bind_thm("leadsto_init_temp",
  34.627 -         rewrite_rule Init_simps (read_instantiate [("'a","behavior")] leadsto_init));
  34.628 -
  34.629 -Goalw [leadsto_def] "|- ([]<>Init F --> []<>G) = (<>(F ~> G))";
  34.630 -by Auto_tac;
  34.631 -by (asm_full_simp_tac (simpset() addsimps more_temp_simps) 1);
  34.632 -by (fast_tac (temp_cs addSEs [DmdImplE,STL4E]) 1);
  34.633 -by (fast_tac (temp_cs addSIs [InitDmd] addSEs [STL4E]) 1);
  34.634 -by (subgoal_tac "sigma |= []<><>G" 1);
  34.635 -by (asm_full_simp_tac (simpset() addsimps more_temp_simps) 1);
  34.636 -by (dtac (temp_use BoxDmdDmdBox) 1);
  34.637 -by (atac 1);
  34.638 -by (fast_tac (temp_cs addSEs [DmdImplE,STL4E]) 1);
  34.639 -qed "streett_leadsto";
  34.640 -
  34.641 -Goal "|- []<>F & (F ~> G) --> []<>G";
  34.642 -by (Clarsimp_tac 1);
  34.643 -by (etac ((temp_use InitDmd) RS
  34.644 -          ((temp_unlift streett_leadsto) RS iffD2 RS mp)) 1);
  34.645 -by (asm_simp_tac (simpset() addsimps [dmdInitD]) 1);
  34.646 -qed "leadsto_infinite";
  34.647 -
  34.648 -(* In particular, strong fairness is a Streett condition. The following
  34.649 -   rules are sometimes easier to use than WF2 or SF2 below.
  34.650 -*)
  34.651 -Goalw [SF_def] "|- (Enabled(<A>_v) ~> <A>_v) --> SF(A)_v";
  34.652 -by (clarsimp_tac (temp_css addSEs2 [leadsto_infinite]) 1);
  34.653 -qed "leadsto_SF";
  34.654 -
  34.655 -Goal "|- (Enabled(<A>_v) ~> <A>_v) --> WF(A)_v";
  34.656 -by (clarsimp_tac (temp_css addSIs2 [SFImplWF, leadsto_SF]) 1);
  34.657 -qed "leadsto_WF";
  34.658 -
  34.659 -(* introduce an invariant into the proof of a leadsto assertion.
  34.660 -   []I --> ((P ~> Q)  =  (P /\ I ~> Q))
  34.661 -*)
  34.662 -Goalw [leadsto_def] "|- []I & (P & I ~> Q) --> (P ~> Q)";
  34.663 -by (Clarsimp_tac 1);
  34.664 -by (etac STL4Edup 1);
  34.665 -by (atac 1);
  34.666 -by (auto_tac (temp_css addsimps2 Init_simps addSDs2 [STL2_gen]));
  34.667 -qed "INV_leadsto";
  34.668 -
  34.669 -Goalw [leadsto_def,dmd_def]
  34.670 -  "|- (Init F & []~G ~> G) --> (F ~> G)";
  34.671 -by (force_tac (temp_css addsimps2 Init_simps addSEs2 [STL4E]) 1);
  34.672 -qed "leadsto_classical";
  34.673 -
  34.674 -Goalw [leadsto_def] "|- (F ~> #False) = ([]~F)";
  34.675 -by (simp_tac (simpset() addsimps [boxNotInitD]) 1);
  34.676 -qed "leadsto_false";
  34.677 -
  34.678 -Goalw [leadsto_def] "|- ((EX x. F x) ~> G) = (ALL x. (F x ~> G))";
  34.679 -by (auto_tac (temp_css addsimps2 allT::Init_simps addSEs2 [STL4E]));
  34.680 -qed "leadsto_exists";
  34.681 -
  34.682 -(* basic leadsto properties, cf. Unity *)
  34.683 -
  34.684 -Goalw [leadsto_def] "|- [](Init F --> Init G) --> (F ~> G)";
  34.685 -by (auto_tac (temp_css addSIs2 [InitDmd_gen] addSEs2 [STL4E_gen]
  34.686 -                       addsimps2 Init_simps));
  34.687 -qed "ImplLeadsto_gen";
  34.688 -
  34.689 -bind_thm("ImplLeadsto",
  34.690 -         rewrite_rule Init_simps
  34.691 -             (read_instantiate [("'a","behavior"), ("'b","behavior")] ImplLeadsto_gen));
  34.692 -
  34.693 -Goal "!!F G. |- F --> G ==> |- F ~> G";
  34.694 -by (auto_tac (temp_css addsimps2 [Init_def]
  34.695 -                       addSIs2 [ImplLeadsto_gen,necT]));
  34.696 -qed "ImplLeadsto_simple";
  34.697 -
  34.698 -val [prem] = goalw (the_context ()) [leadsto_def]
  34.699 -  "|- A & $P --> Q` ==> |- []A --> (P ~> Q)";
  34.700 -by (clarsimp_tac (temp_css addSEs2 [INV_leadsto]) 1);
  34.701 -by (etac STL4E_gen 1);
  34.702 -by (auto_tac (temp_css addsimps2 Init_defs addSIs2 [PrimeDmd,prem]));
  34.703 -qed "EnsuresLeadsto";
  34.704 -
  34.705 -Goalw  [leadsto_def] "|- []($P --> Q`) --> (P ~> Q)";
  34.706 -by (Clarsimp_tac 1);
  34.707 -by (etac STL4E_gen 1);
  34.708 -by (auto_tac (temp_css addsimps2 Init_simps addSIs2 [PrimeDmd]));
  34.709 -qed "EnsuresLeadsto2";
  34.710 -
  34.711 -val [p1,p2] = goalw (the_context ()) [leadsto_def]
  34.712 -  "[| |- $P & N --> P` | Q`; \
  34.713 -\     |- ($P & N) & A --> Q` \
  34.714 -\  |] ==> |- []N & []([]P --> <>A) --> (P ~> Q)";
  34.715 -by (Clarsimp_tac 1);
  34.716 -by (etac STL4Edup 1);
  34.717 -by (atac 1);
  34.718 -by (Clarsimp_tac 1);
  34.719 -by (subgoal_tac "sigmaa |= []($P --> P` | Q`)" 1);
  34.720 - by (dtac (temp_use unless) 1);
  34.721 - by (clarsimp_tac (temp_css addSDs2 [INV1]) 1);
  34.722 - by (rtac ((temp_use (p2 RS DmdImpl)) RS (temp_use DmdPrime)) 1);
  34.723 - by (force_tac (temp_css addSIs2 [BoxDmd_simple]
  34.724 -                         addsimps2 [split_box_conj,box_stp_act]) 1);
  34.725 -by (force_tac (temp_css addEs2 [STL4E] addDs2 [p1]) 1);
  34.726 -qed "ensures";
  34.727 -
  34.728 -val prems = goal (the_context ())
  34.729 -  "[| |- $P & N --> P` | Q`; \
  34.730 -\     |- ($P & N) & A --> Q` \
  34.731 -\  |] ==> |- []N & []<>A --> (P ~> Q)";
  34.732 -by (Clarsimp_tac 1);
  34.733 -by (rtac (temp_use ensures) 1);
  34.734 -by (TRYALL (ares_tac prems));
  34.735 -by (force_tac (temp_css addSEs2 [STL4E]) 1);
  34.736 -qed "ensures_simple";
  34.737 -
  34.738 -val prems = goal (the_context ())
  34.739 -  "[| sigma |= []<>P; sigma |= []A; |- A & $P --> Q` |] ==> sigma |= []<>Q";
  34.740 -by (REPEAT (resolve_tac (prems @
  34.741 -                         (map temp_use [leadsto_infinite, EnsuresLeadsto])) 1));
  34.742 -qed "EnsuresInfinite";
  34.743 -
  34.744 -
  34.745 -(*** Gronning's lattice rules (taken from TLP) ***)
  34.746 -section "Lattice rules";
  34.747 -
  34.748 -Goalw [leadsto_def] "|- F ~> F";
  34.749 -by (REPEAT (resolve_tac [necT,InitDmd_gen] 1));
  34.750 -qed "LatticeReflexivity";
  34.751 -
  34.752 -Goalw [leadsto_def] "|- (G ~> H) & (F ~> G) --> (F ~> H)";
  34.753 -by (Clarsimp_tac 1);
  34.754 -by (etac dup_boxE 1);  (* [][](Init G --> H) *)
  34.755 -by (merge_box_tac 1);
  34.756 -by (clarsimp_tac (temp_css addSEs2 [STL4E]) 1);
  34.757 -by (rtac dup_dmdD 1);
  34.758 -by (subgoal_tac "sigmaa |= <>Init G" 1);
  34.759 - by (etac DmdImpl2 1);
  34.760 - by (atac 1);
  34.761 -by (asm_simp_tac (simpset() addsimps [dmdInitD]) 1);
  34.762 -qed "LatticeTransitivity";
  34.763 -
  34.764 -Goalw [leadsto_def] "|- (F | G ~> H) --> (F ~> H)";
  34.765 -by (auto_tac (temp_css addsimps2 Init_simps addSEs2 [STL4E]));
  34.766 -qed "LatticeDisjunctionElim1";
  34.767 -
  34.768 -Goalw [leadsto_def] "|- (F | G ~> H) --> (G ~> H)";
  34.769 -by (auto_tac (temp_css addsimps2 Init_simps addSEs2 [STL4E]));
  34.770 -qed "LatticeDisjunctionElim2";
  34.771 -
  34.772 -Goalw [leadsto_def] "|- (F ~> H) & (G ~> H) --> (F | G ~> H)";
  34.773 -by (Clarsimp_tac 1);
  34.774 -by (merge_box_tac 1);
  34.775 -by (auto_tac (temp_css addsimps2 Init_simps addSEs2 [STL4E]));
  34.776 -qed "LatticeDisjunctionIntro";
  34.777 -
  34.778 -Goal "|- (F | G ~> H) = ((F ~> H) & (G ~> H))";
  34.779 -by (auto_tac (temp_css addIs2 [LatticeDisjunctionIntro,
  34.780 -                               LatticeDisjunctionElim1, LatticeDisjunctionElim2]));
  34.781 -qed "LatticeDisjunction";
  34.782 -
  34.783 -Goal "|- (A ~> B | C) & (B ~> D) & (C ~> D) --> (A ~> D)";
  34.784 -by (Clarsimp_tac 1);
  34.785 -by (subgoal_tac "sigma |= (B | C) ~> D" 1);
  34.786 -by (eres_inst_tac [("G", "LIFT (B | C)")] (temp_use LatticeTransitivity) 1);
  34.787 -by (ALLGOALS (fast_tac (temp_cs addSIs [LatticeDisjunctionIntro])));
  34.788 -qed "LatticeDiamond";
  34.789 -
  34.790 -Goal "|- (A ~> D | B) & (B ~> D) --> (A ~> D)";
  34.791 -by (Clarsimp_tac 1);
  34.792 -by (subgoal_tac "sigma |= (D | B) ~> D" 1);
  34.793 -by (eres_inst_tac [("G", "LIFT (D | B)")] (temp_use LatticeTransitivity) 1);
  34.794 -by (atac 1);
  34.795 -by (auto_tac (temp_css addIs2 [LatticeDisjunctionIntro,LatticeReflexivity]));
  34.796 -qed "LatticeTriangle";
  34.797 -
  34.798 -Goal "|- (A ~> B | D) & (B ~> D) --> (A ~> D)";
  34.799 -by (Clarsimp_tac 1);
  34.800 -by (subgoal_tac "sigma |= B | D ~> D" 1);
  34.801 -by (eres_inst_tac [("G", "LIFT (B | D)")] (temp_use LatticeTransitivity) 1);
  34.802 -by (atac 1);
  34.803 -by (auto_tac (temp_css addIs2 [LatticeDisjunctionIntro,LatticeReflexivity]));
  34.804 -qed "LatticeTriangle2";
  34.805 -
  34.806 -(*** Lamport's fairness rules ***)
  34.807 -section "Fairness rules";
  34.808 -
  34.809 -val prems = goal (the_context ())
  34.810 -  "[| |- $P & N  --> P` | Q`;   \
  34.811 -\     |- ($P & N) & <A>_v --> Q`;   \
  34.812 -\     |- $P & N --> $(Enabled(<A>_v)) |]   \
  34.813 -\ ==> |- []N & WF(A)_v --> (P ~> Q)";
  34.814 -by (clarsimp_tac (temp_css addSDs2 [BoxWFI]) 1);
  34.815 -by (rtac (temp_use ensures) 1);
  34.816 -by (TRYALL (ares_tac prems));
  34.817 -by (etac STL4Edup 1);
  34.818 -by (atac 1);
  34.819 -by (clarsimp_tac (temp_css addsimps2 [WF_def]) 1);
  34.820 -by (rtac (temp_use STL2) 1);
  34.821 -by (clarsimp_tac (temp_css addSEs2 [mp] addSIs2 [InitDmd]) 1);
  34.822 -by (resolve_tac ((map temp_use (prems RL [STL4])) RL [box_stp_actD]) 1);
  34.823 -by (asm_simp_tac (simpset() addsimps [split_box_conj,box_stp_actI]) 1);
  34.824 -qed "WF1";
  34.825 -
  34.826 -(* Sometimes easier to use; designed for action B rather than state predicate Q *)
  34.827 -val [prem1,prem2,prem3] = goalw (the_context ()) [leadsto_def]
  34.828 -  "[| |- N & $P --> $Enabled (<A>_v);            \
  34.829 -\     |- N & <A>_v --> B;                  \
  34.830 -\     |- [](N & [~A]_v) --> stable P  |]  \
  34.831 -\  ==> |- []N & WF(A)_v --> (P ~> B)";
  34.832 -by (clarsimp_tac (temp_css addSDs2 [BoxWFI]) 1);
  34.833 -by (etac STL4Edup 1);
  34.834 -by (atac 1);
  34.835 -by (Clarsimp_tac 1);
  34.836 -by (rtac (temp_use (prem2 RS DmdImpl)) 1);
  34.837 -by (rtac (temp_use BoxDmd_simple) 1);
  34.838 -by (atac 1);
  34.839 -by (rtac classical 1);
  34.840 -by (rtac (temp_use STL2) 1);
  34.841 -by (clarsimp_tac (temp_css addsimps2 [WF_def] addSEs2 [mp] addSIs2 [InitDmd]) 1);
  34.842 -by (rtac ((temp_use (prem1 RS STL4)) RS box_stp_actD) 1);
  34.843 -by (asm_simp_tac (simpset() addsimps [split_box_conj,box_stp_act]) 1);
  34.844 -by (etac (temp_use INV1) 1);
  34.845 -by (rtac (temp_use prem3) 1);
  34.846 -by (asm_full_simp_tac (simpset() addsimps [split_box_conj,temp_use NotDmd,not_angle]) 1);
  34.847 -qed "WF_leadsto";
  34.848 -
  34.849 -val prems = goal (the_context ())
  34.850 -  "[| |- $P & N  --> P` | Q`;   \
  34.851 -\     |- ($P & N) & <A>_v --> Q`;   \
  34.852 -\     |- []P & []N & []F --> <>Enabled(<A>_v) |]   \
  34.853 -\ ==> |- []N & SF(A)_v & []F --> (P ~> Q)";
  34.854 -by (clarsimp_tac (temp_css addSDs2 [BoxSFI]) 1);
  34.855 -by (rtac (temp_use ensures) 1);
  34.856 -by (TRYALL (ares_tac prems));
  34.857 -by (eres_inst_tac [("F","F")] dup_boxE 1);
  34.858 -by (merge_temp_box_tac 1);
  34.859 -by (etac STL4Edup 1);
  34.860 -by (atac 1);
  34.861 -by (clarsimp_tac (temp_css addsimps2 [SF_def]) 1);
  34.862 -by (rtac (temp_use STL2) 1);
  34.863 -by (etac mp 1);
  34.864 -by (resolve_tac (map temp_use (prems RL [STL4])) 1);
  34.865 -by (asm_simp_tac (simpset() addsimps [split_box_conj, STL3]) 1);
  34.866 -qed "SF1";
  34.867 -
  34.868 -val [prem1,prem2,prem3,prem4] = goal (the_context ())
  34.869 -  "[| |- N & <B>_f --> <M>_g;   \
  34.870 -\     |- $P & P` & <N & A>_f --> B;   \
  34.871 -\     |- P & Enabled(<M>_g) --> Enabled(<A>_f);   \
  34.872 -\     |- [](N & [~B]_f) & WF(A)_f & []F & <>[]Enabled(<M>_g) --> <>[]P |]   \
  34.873 -\ ==> |- []N & WF(A)_f & []F --> WF(M)_g";
  34.874 -by (clarsimp_tac (temp_css addSDs2 [BoxWFI, (temp_use BoxDmdBox) RS iffD2]
  34.875 -                           addsimps2 [read_instantiate [("A","M")] WF_def]) 1);
  34.876 -by (eres_inst_tac [("F","F")] dup_boxE 1);
  34.877 -by (merge_temp_box_tac 1);
  34.878 -by (etac STL4Edup 1);
  34.879 -by (atac 1);
  34.880 -by (clarsimp_tac (temp_css addSIs2
  34.881 -         [(temp_use BoxDmd_simple) RS (temp_use (prem1 RS DmdImpl))]) 1);
  34.882 -by (rtac classical 1);
  34.883 -by (subgoal_tac "sigmaa |= <>(($P & P` & N) & <A>_f)" 1);
  34.884 - by (force_tac (temp_css addsimps2 [angle_def] addSIs2 [prem2] addSEs2 [DmdImplE]) 1);
  34.885 -by (rtac (temp_use (rewrite_rule [temp_rewrite DmdDmd] (BoxDmd_simple RS DmdImpl))) 1);
  34.886 -by (asm_full_simp_tac (simpset() addsimps [temp_use NotDmd, not_angle]) 1);
  34.887 -by (merge_act_box_tac 1);
  34.888 -by (forward_tac [temp_use prem4] 1);
  34.889 -by (TRYALL atac);
  34.890 -by (dtac (temp_use STL6) 1);
  34.891 -by (atac 1);
  34.892 -by (eres_inst_tac [("V","sigmaa |= <>[]P")] thin_rl 1);
  34.893 -by (eres_inst_tac [("V","sigmaa |= []F")] thin_rl 1);
  34.894 -by (dtac (temp_use BoxWFI) 1);
  34.895 -by (eres_inst_tac [("F", "ACT N & [~B]_f")] dup_boxE 1);
  34.896 -by (merge_temp_box_tac 1);
  34.897 -by (etac DmdImpldup 1);
  34.898 -by (atac 1);
  34.899 -by (auto_tac (temp_css addsimps2 [split_box_conj,STL3,WF_Box,box_stp_act]));
  34.900 - by (force_tac (temp_css addSEs2 [read_instantiate [("P","P")] TLA2E]) 1);
  34.901 -by (rtac (temp_use STL2) 1);
  34.902 -by (force_tac (temp_css addsimps2 [WF_def,split_box_conj] addSEs2 [mp]
  34.903 -                        addSIs2 [InitDmd, prem3 RS STL4]) 1);
  34.904 -qed "WF2";
  34.905 -
  34.906 -val [prem1,prem2,prem3,prem4] = goal (the_context ())
  34.907 -  "[| |- N & <B>_f --> <M>_g;   \
  34.908 -\     |- $P & P` & <N & A>_f --> B;   \
  34.909 -\     |- P & Enabled(<M>_g) --> Enabled(<A>_f);   \
  34.910 -\     |- [](N & [~B]_f) & SF(A)_f & []F & []<>Enabled(<M>_g) --> <>[]P |]   \
  34.911 -\ ==> |- []N & SF(A)_f & []F --> SF(M)_g";
  34.912 -by (clarsimp_tac (temp_css addSDs2 [BoxSFI]
  34.913 -                           addsimps2 [read_instantiate [("A","M")] SF_def]) 1);
  34.914 -by (eres_inst_tac [("F","F")] dup_boxE 1);
  34.915 -by (eres_inst_tac [("F","TEMP <>Enabled(<M>_g)")] dup_boxE 1);
  34.916 -by (merge_temp_box_tac 1);
  34.917 -by (etac STL4Edup 1);
  34.918 -by (atac 1);
  34.919 -by (clarsimp_tac (temp_css addSIs2
  34.920 -        [(temp_use BoxDmd_simple) RS (temp_use (prem1 RS DmdImpl))]) 1);
  34.921 -by (rtac classical 1);
  34.922 -by (subgoal_tac "sigmaa |= <>(($P & P` & N) & <A>_f)" 1);
  34.923 - by (force_tac (temp_css addsimps2 [angle_def] addSIs2 [prem2] addSEs2 [DmdImplE]) 1);
  34.924 -by (rtac (temp_use (rewrite_rule [temp_rewrite DmdDmd] (BoxDmd_simple RS DmdImpl))) 1);
  34.925 -by (asm_full_simp_tac (simpset() addsimps [temp_use NotDmd, not_angle]) 1);
  34.926 -by (merge_act_box_tac 1);
  34.927 -by (forward_tac [temp_use prem4] 1);
  34.928 -by (TRYALL atac);
  34.929 -by (eres_inst_tac [("V","sigmaa |= []F")] thin_rl 1);
  34.930 -by (dtac (temp_use BoxSFI) 1);
  34.931 -by (eres_inst_tac [("F","TEMP <>Enabled(<M>_g)")] dup_boxE 1);
  34.932 -by (eres_inst_tac [("F", "ACT N & [~B]_f")] dup_boxE 1);
  34.933 -by (merge_temp_box_tac 1);
  34.934 -by (etac DmdImpldup 1);
  34.935 -by (atac 1);
  34.936 -by (auto_tac (temp_css addsimps2 [split_box_conj,STL3,SF_Box,box_stp_act]));
  34.937 - by (force_tac (temp_css addSEs2 [read_instantiate [("P","P")] TLA2E]) 1);
  34.938 -by (rtac (temp_use STL2) 1);
  34.939 -by (force_tac (temp_css addsimps2 [SF_def,split_box_conj] addSEs2 [mp,InfImpl]
  34.940 -                        addSIs2 [prem3]) 1);
  34.941 -qed "SF2";
  34.942 -
  34.943 -(* ------------------------------------------------------------------------- *)
  34.944 -(***           Liveness proofs by well-founded orderings                   ***)
  34.945 -(* ------------------------------------------------------------------------- *)
  34.946 -section "Well-founded orderings";
  34.947 -
  34.948 -val p1::prems = goal (the_context ())
  34.949 -  "[| wf r;  \
  34.950 -\     !!x. sigma |= F x ~> (G | (EX y. #((y,x):r) & F y))   \
  34.951 -\  |] ==> sigma |= F x ~> G";
  34.952 -by (rtac (p1 RS wf_induct) 1);
  34.953 -by (rtac (temp_use LatticeTriangle) 1);
  34.954 -by (resolve_tac prems 1);
  34.955 -by (auto_tac (temp_css addsimps2 [leadsto_exists]));
  34.956 -by (case_tac "(y,x):r" 1);
  34.957 - by (Force_tac 1);
  34.958 -by (force_tac (temp_css addsimps2 leadsto_def::Init_simps addSIs2 [necT]) 1);
  34.959 -qed "wf_leadsto";
  34.960 -
  34.961 -(* If r is well-founded, state function v cannot decrease forever *)
  34.962 -Goal "!!r. wf r ==> |- [][ (v`, $v) : #r ]_v --> <>[][#False]_v";
  34.963 -by (Clarsimp_tac 1);
  34.964 -by (rtac ccontr 1);
  34.965 -by (subgoal_tac "sigma |= (EX x. v=#x) ~> #False" 1);
  34.966 - by (dtac ((temp_use leadsto_false) RS iffD1 RS (temp_use STL2_gen)) 1);
  34.967 - by (force_tac (temp_css addsimps2 Init_defs) 1);
  34.968 -by (clarsimp_tac (temp_css addsimps2 [leadsto_exists,not_square]@more_temp_simps) 1);
  34.969 -by (etac wf_leadsto 1);
  34.970 -by (rtac (temp_use ensures_simple) 1);
  34.971 -by (TRYALL atac);
  34.972 -by (auto_tac (temp_css addsimps2 [square_def,angle_def]));
  34.973 -qed "wf_not_box_decrease";
  34.974 -
  34.975 -(* "wf r  ==>  |- <>[][ (v`, $v) : #r ]_v --> <>[][#False]_v" *)
  34.976 -bind_thm("wf_not_dmd_box_decrease",
  34.977 -         standard(rewrite_rule more_temp_simps (wf_not_box_decrease RS DmdImpl)));
  34.978 -
  34.979 -(* If there are infinitely many steps where v decreases, then there
  34.980 -   have to be infinitely many non-stuttering steps where v doesn't decrease.
  34.981 -*)
  34.982 -val [prem] = goal (the_context ())
  34.983 -  "wf r ==> |- []<>((v`, $v) : #r) --> []<><(v`, $v) ~: #r>_v";
  34.984 -by (Clarsimp_tac 1);
  34.985 -by (rtac ccontr 1);
  34.986 -by (asm_full_simp_tac (simpset() addsimps not_angle::more_temp_simps) 1);
  34.987 -by (dtac (prem RS (temp_use wf_not_dmd_box_decrease)) 1);
  34.988 -by (dtac (temp_use BoxDmdDmdBox) 1);
  34.989 -by (atac 1);
  34.990 -by (subgoal_tac "sigma |= []<>((#False)::action)" 1);
  34.991 - by (Force_tac 1);
  34.992 -by (etac STL4E 1);
  34.993 -by (rtac DmdImpl 1);
  34.994 -by (force_tac (temp_css addIs2 [prem RS wf_irrefl]) 1);
  34.995 -qed "wf_box_dmd_decrease";
  34.996 -
  34.997 -(* In particular, for natural numbers, if n decreases infinitely often
  34.998 -   then it has to increase infinitely often.
  34.999 -*)
 34.1000 -Goal "!!n::nat stfun. |- []<>(n` < $n) --> []<>($n < n`)";
 34.1001 -by (Clarsimp_tac 1);
 34.1002 -by (subgoal_tac "sigma |= []<><~( (n`,$n) : #less_than )>_n" 1);
 34.1003 - by (etac thin_rl 1);
 34.1004 - by (etac STL4E 1);
 34.1005 - by (rtac DmdImpl 1);
 34.1006 - by (clarsimp_tac (temp_css addsimps2 [angle_def]) 1);
 34.1007 -by (rtac (temp_use wf_box_dmd_decrease) 1);
 34.1008 -by (auto_tac (temp_css addSEs2 [STL4E,DmdImplE]));
 34.1009 -qed "nat_box_dmd_decrease";
 34.1010 -
 34.1011 -
 34.1012 -(* ------------------------------------------------------------------------- *)
 34.1013 -(***           Flexible quantification over state variables                ***)
 34.1014 -(* ------------------------------------------------------------------------- *)
 34.1015 -section "Flexible quantification";
 34.1016 -
 34.1017 -val [prem1,prem2] = goal (the_context ())
 34.1018 -  "[| basevars vs; (!!x. basevars (x,vs) ==> sigma |= F x) |]\
 34.1019 -\  ==> sigma |= (AALL x. F x)";
 34.1020 -by (auto_tac (temp_css addsimps2 [aall_def] addSEs2 [eexE]
 34.1021 -                       addSIs2 [prem1] addSDs2 [prem2]));
 34.1022 -qed "aallI";
 34.1023 -
 34.1024 -Goalw [aall_def] "|- (AALL x. F x) --> F x";
 34.1025 -by (Clarsimp_tac 1);
 34.1026 -by (etac contrapos_np 1);
 34.1027 -by (force_tac (temp_css addSIs2 [eexI]) 1);
 34.1028 -qed "aallE";
 34.1029 -
 34.1030 -(* monotonicity of quantification *)
 34.1031 -val [min,maj] = goal (the_context ())
 34.1032 -  "[| sigma |= EEX x. F x; !!x. sigma |= F x --> G x |] ==> sigma |= EEX x. G x";
 34.1033 -by (rtac (unit_base RS (min RS eexE)) 1);
 34.1034 -by (rtac (temp_use eexI) 1);
 34.1035 -by (etac ((rewrite_rule intensional_rews maj) RS mp) 1);
 34.1036 -qed "eex_mono";
 34.1037 -
 34.1038 -val [min,maj] = goal (the_context ())
 34.1039 -  "[| sigma |= AALL x. F(x); !!x. sigma |= F(x) --> G(x) |] ==> sigma |= AALL x. G(x)";
 34.1040 -by (rtac (unit_base RS aallI) 1);
 34.1041 -by (rtac ((rewrite_rule intensional_rews maj) RS mp) 1);
 34.1042 -by (rtac (min RS (temp_use aallE)) 1);
 34.1043 -qed "aall_mono";
 34.1044 -
 34.1045 -(* Derived history introduction rule *)
 34.1046 -val [p1,p2,p3,p4,p5] = goal (the_context ())
 34.1047 -  "[| sigma |= Init I; sigma |= []N; basevars vs; \
 34.1048 -\     (!!h. basevars(h,vs) ==> |- I & h = ha --> HI h); \
 34.1049 -\     (!!h s t. [| basevars(h,vs); N (s,t); h t = hb (h s) (s,t) |] ==> HN h (s,t)) \
 34.1050 -\  |] ==> sigma |= EEX h. Init (HI h) & [](HN h)";
 34.1051 -by (rtac ((temp_use history) RS eexE) 1);
 34.1052 - by (rtac p3 1);
 34.1053 -by (rtac (temp_use eexI) 1);
 34.1054 -by (Clarsimp_tac 1);
 34.1055 -by (rtac conjI 1);
 34.1056 -by (cut_facts_tac [p2] 2);
 34.1057 -by (merge_box_tac 2);
 34.1058 -by (force_tac (temp_css addSEs2 [STL4E,p5]) 2);
 34.1059 -by (cut_facts_tac [p1] 1);
 34.1060 -by (force_tac (temp_css addsimps2 Init_defs addSEs2 [p4]) 1);
 34.1061 -qed "historyI";
 34.1062 -
 34.1063 -(* ----------------------------------------------------------------------
 34.1064 -   example of a history variable: existence of a clock
 34.1065 -
 34.1066 -Goal "|- EEX h. Init(h = #True) & [](h` = (~$h))";
 34.1067 -by (rtac tempI 1);
 34.1068 -by (rtac historyI 1);
 34.1069 -by (REPEAT (force_tac (temp_css addsimps2 Init_defs addIs2 [unit_base, necT]) 1));
 34.1070 -(** solved **)
 34.1071 -
 34.1072 ----------------------------------------------------------------------- *)
    35.1 --- a/src/HOL/TLA/TLA.thy	Fri Dec 01 17:22:33 2006 +0100
    35.2 +++ b/src/HOL/TLA/TLA.thy	Sat Dec 02 02:52:02 2006 +0100
    35.3 @@ -3,12 +3,9 @@
    35.4      ID:          $Id$
    35.5      Author:      Stephan Merz
    35.6      Copyright:   1998 University of Munich
    35.7 +*)
    35.8  
    35.9 -    Theory Name: TLA
   35.10 -    Logic Image: HOL
   35.11 -
   35.12 -The temporal level of TLA.
   35.13 -*)
   35.14 +header {* The temporal level of TLA *}
   35.15  
   35.16  theory TLA
   35.17  imports Init
   35.18 @@ -99,6 +96,1108 @@
   35.19                |] ==> G sigma"
   35.20    history:    "|- EEX h. Init(h = ha) & [](!x. $h = #x --> h` = hb x)"
   35.21  
   35.22 -ML {* use_legacy_bindings (the_context ()) *}
   35.23 +
   35.24 +(* Specialize intensional introduction/elimination rules for temporal formulas *)
   35.25 +
   35.26 +lemma tempI: "(!!sigma. sigma |= (F::temporal)) ==> |- F"
   35.27 +  apply (rule intI)
   35.28 +  apply (erule meta_spec)
   35.29 +  done
   35.30 +
   35.31 +lemma tempD: "|- (F::temporal) ==> sigma |= F"
   35.32 +  by (erule intD)
   35.33 +
   35.34 +
   35.35 +(* ======== Functions to "unlift" temporal theorems ====== *)
   35.36 +
   35.37 +ML {*
   35.38 +(* The following functions are specialized versions of the corresponding
   35.39 +   functions defined in theory Intensional in that they introduce a
   35.40 +   "world" parameter of type "behavior".
   35.41 +*)
   35.42 +local
   35.43 +  val action_rews = thms "action_rews";
   35.44 +  val tempD = thm "tempD";
   35.45 +in
   35.46 +
   35.47 +fun temp_unlift th =
   35.48 +  (rewrite_rule action_rews (th RS tempD)) handle THM _ => action_unlift th;
   35.49 +
   35.50 +(* Turn  |- F = G  into meta-level rewrite rule  F == G *)
   35.51 +val temp_rewrite = int_rewrite
   35.52 +
   35.53 +fun temp_use th =
   35.54 +  case (concl_of th) of
   35.55 +    Const _ $ (Const ("Intensional.Valid", _) $ _) =>
   35.56 +            ((flatten (temp_unlift th)) handle THM _ => th)
   35.57 +  | _ => th;
   35.58 +
   35.59 +fun try_rewrite th = temp_rewrite th handle THM _ => temp_use th;
   35.60 +
   35.61 +end
   35.62 +*}
   35.63 +
   35.64 +setup {*
   35.65 +  Attrib.add_attributes [
   35.66 +    ("temp_unlift", Attrib.no_args (Thm.rule_attribute (K temp_unlift)), ""),
   35.67 +    ("temp_rewrite", Attrib.no_args (Thm.rule_attribute (K temp_rewrite)), ""),
   35.68 +    ("temp_use", Attrib.no_args (Thm.rule_attribute (K temp_use)), ""),
   35.69 +    ("try_rewrite", Attrib.no_args (Thm.rule_attribute (K try_rewrite)), "")]
   35.70 +*}
   35.71 +
   35.72 +(* Update classical reasoner---will be updated once more below! *)
   35.73 +
   35.74 +declare tempI [intro!]
   35.75 +declare tempD [dest]
   35.76 +ML {*
   35.77 +val temp_css = (claset(), simpset())
   35.78 +val temp_cs = op addss temp_css
   35.79 +*}
   35.80 +
   35.81 +(* Modify the functions that add rules to simpsets, classical sets,
   35.82 +   and clasimpsets in order to accept "lifted" theorems
   35.83 +*)
   35.84 +
   35.85 +(* ------------------------------------------------------------------------- *)
   35.86 +(***           "Simple temporal logic": only [] and <>                     ***)
   35.87 +(* ------------------------------------------------------------------------- *)
   35.88 +section "Simple temporal logic"
   35.89 +
   35.90 +(* []~F == []~Init F *)
   35.91 +lemmas boxNotInit = boxInit [of "LIFT ~F", unfolded Init_simps, standard]
   35.92 +
   35.93 +lemma dmdInit: "TEMP <>F == TEMP <> Init F"
   35.94 +  apply (unfold dmd_def)
   35.95 +  apply (unfold boxInit [of "LIFT ~F"])
   35.96 +  apply (simp (no_asm) add: Init_simps)
   35.97 +  done
   35.98 +
   35.99 +lemmas dmdNotInit = dmdInit [of "LIFT ~F", unfolded Init_simps, standard]
  35.100 +
  35.101 +(* boxInit and dmdInit cannot be used as rewrites, because they loop.
  35.102 +   Non-looping instances for state predicates and actions are occasionally useful.
  35.103 +*)
  35.104 +lemmas boxInit_stp = boxInit [where 'a = state, standard]
  35.105 +lemmas boxInit_act = boxInit [where 'a = "state * state", standard]
  35.106 +lemmas dmdInit_stp = dmdInit [where 'a = state, standard]
  35.107 +lemmas dmdInit_act = dmdInit [where 'a = "state * state", standard]
  35.108 +
  35.109 +(* The symmetric equations can be used to get rid of Init *)
  35.110 +lemmas boxInitD = boxInit [symmetric]
  35.111 +lemmas dmdInitD = dmdInit [symmetric]
  35.112 +lemmas boxNotInitD = boxNotInit [symmetric]
  35.113 +lemmas dmdNotInitD = dmdNotInit [symmetric]
  35.114 +
  35.115 +lemmas Init_simps = Init_simps boxInitD dmdInitD boxNotInitD dmdNotInitD
  35.116 +
  35.117 +(* ------------------------ STL2 ------------------------------------------- *)
  35.118 +lemmas STL2 = reflT
  35.119 +
  35.120 +(* The "polymorphic" (generic) variant *)
  35.121 +lemma STL2_gen: "|- []F --> Init F"
  35.122 +  apply (unfold boxInit [of F])
  35.123 +  apply (rule STL2)
  35.124 +  done
  35.125 +
  35.126 +(* see also STL2_pr below: "|- []P --> Init P & Init (P`)" *)
  35.127 +
  35.128 +
  35.129 +(* Dual versions for <> *)
  35.130 +lemma InitDmd: "|- F --> <> F"
  35.131 +  apply (unfold dmd_def)
  35.132 +  apply (auto dest!: STL2 [temp_use])
  35.133 +  done
  35.134 +
  35.135 +lemma InitDmd_gen: "|- Init F --> <>F"
  35.136 +  apply clarsimp
  35.137 +  apply (drule InitDmd [temp_use])
  35.138 +  apply (simp add: dmdInitD)
  35.139 +  done
  35.140 +
  35.141 +
  35.142 +(* ------------------------ STL3 ------------------------------------------- *)
  35.143 +lemma STL3: "|- ([][]F) = ([]F)"
  35.144 +  by (auto elim: transT [temp_use] STL2 [temp_use])
  35.145 +
  35.146 +(* corresponding elimination rule introduces double boxes:
  35.147 +   [| (sigma |= []F); (sigma |= [][]F) ==> PROP W |] ==> PROP W
  35.148 +*)
  35.149 +lemmas dup_boxE = STL3 [temp_unlift, THEN iffD2, elim_format]
  35.150 +lemmas dup_boxD = STL3 [temp_unlift, THEN iffD1, standard]
  35.151 +
  35.152 +(* dual versions for <> *)
  35.153 +lemma DmdDmd: "|- (<><>F) = (<>F)"
  35.154 +  by (auto simp add: dmd_def [try_rewrite] STL3 [try_rewrite])
  35.155 +
  35.156 +lemmas dup_dmdE = DmdDmd [temp_unlift, THEN iffD2, elim_format]
  35.157 +lemmas dup_dmdD = DmdDmd [temp_unlift, THEN iffD1, standard]
  35.158 +
  35.159 +
  35.160 +(* ------------------------ STL4 ------------------------------------------- *)
  35.161 +lemma STL4:
  35.162 +  assumes "|- F --> G"
  35.163 +  shows "|- []F --> []G"
  35.164 +  apply clarsimp
  35.165 +  apply (rule normalT [temp_use])
  35.166 +   apply (rule assms [THEN necT, temp_use])
  35.167 +  apply assumption
  35.168 +  done
  35.169 +
  35.170 +(* Unlifted version as an elimination rule *)
  35.171 +lemma STL4E: "[| sigma |= []F; |- F --> G |] ==> sigma |= []G"
  35.172 +  by (erule (1) STL4 [temp_use])
  35.173 +
  35.174 +lemma STL4_gen: "|- Init F --> Init G ==> |- []F --> []G"
  35.175 +  apply (drule STL4)
  35.176 +  apply (simp add: boxInitD)
  35.177 +  done
  35.178 +
  35.179 +lemma STL4E_gen: "[| sigma |= []F; |- Init F --> Init G |] ==> sigma |= []G"
  35.180 +  by (erule (1) STL4_gen [temp_use])
  35.181 +
  35.182 +(* see also STL4Edup below, which allows an auxiliary boxed formula:
  35.183 +       []A /\ F => G
  35.184 +     -----------------
  35.185 +     []A /\ []F => []G
  35.186 +*)
  35.187 +
  35.188 +(* The dual versions for <> *)
  35.189 +lemma DmdImpl:
  35.190 +  assumes prem: "|- F --> G"
  35.191 +  shows "|- <>F --> <>G"
  35.192 +  apply (unfold dmd_def)
  35.193 +  apply (fastsimp intro!: prem [temp_use] elim!: STL4E [temp_use])
  35.194 +  done
  35.195 +
  35.196 +lemma DmdImplE: "[| sigma |= <>F; |- F --> G |] ==> sigma |= <>G"
  35.197 +  by (erule (1) DmdImpl [temp_use])
  35.198 +
  35.199 +(* ------------------------ STL5 ------------------------------------------- *)
  35.200 +lemma STL5: "|- ([]F & []G) = ([](F & G))"
  35.201 +  apply auto
  35.202 +  apply (subgoal_tac "sigma |= [] (G --> (F & G))")
  35.203 +     apply (erule normalT [temp_use])
  35.204 +     apply (fastsimp elim!: STL4E [temp_use])+
  35.205 +  done
  35.206 +
  35.207 +(* rewrite rule to split conjunctions under boxes *)
  35.208 +lemmas split_box_conj = STL5 [temp_unlift, symmetric, standard]
  35.209 +
  35.210 +
  35.211 +(* the corresponding elimination rule allows to combine boxes in the hypotheses
  35.212 +   (NB: F and G must have the same type, i.e., both actions or temporals.)
  35.213 +   Use "addSE2" etc. if you want to add this to a claset, otherwise it will loop!
  35.214 +*)
  35.215 +lemma box_conjE:
  35.216 +  assumes "sigma |= []F"
  35.217 +     and "sigma |= []G"
  35.218 +  and "sigma |= [](F&G) ==> PROP R"
  35.219 +  shows "PROP R"
  35.220 +  by (rule assms STL5 [temp_unlift, THEN iffD1] conjI)+
  35.221 +
  35.222 +(* Instances of box_conjE for state predicates, actions, and temporals
  35.223 +   in case the general rule is "too polymorphic".
  35.224 +*)
  35.225 +lemmas box_conjE_temp = box_conjE [where 'a = behavior, standard]
  35.226 +lemmas box_conjE_stp = box_conjE [where 'a = state, standard]
  35.227 +lemmas box_conjE_act = box_conjE [where 'a = "state * state", standard]
  35.228 +
  35.229 +(* Define a tactic that tries to merge all boxes in an antecedent. The definition is
  35.230 +   a bit kludgy in order to simulate "double elim-resolution".
  35.231 +*)
  35.232 +
  35.233 +lemma box_thin: "[| sigma |= []F; PROP W |] ==> PROP W" .
  35.234 +
  35.235 +ML {*
  35.236 +local
  35.237 +  val box_conjE = thm "box_conjE";
  35.238 +  val box_thin = thm "box_thin";
  35.239 +  val box_conjE_temp = thm "box_conjE_temp";
  35.240 +  val box_conjE_stp = thm "box_conjE_stp";
  35.241 +  val box_conjE_act = thm "box_conjE_act";
  35.242 +in
  35.243 +
  35.244 +fun merge_box_tac i =
  35.245 +   REPEAT_DETERM (EVERY [etac box_conjE i, atac i, etac box_thin i])
  35.246 +
  35.247 +fun merge_temp_box_tac i =
  35.248 +   REPEAT_DETERM (EVERY [etac box_conjE_temp i, atac i,
  35.249 +                         eres_inst_tac [("'a","behavior")] box_thin i])
  35.250 +
  35.251 +fun merge_stp_box_tac i =
  35.252 +   REPEAT_DETERM (EVERY [etac box_conjE_stp i, atac i,
  35.253 +                         eres_inst_tac [("'a","state")] box_thin i])
  35.254 +
  35.255 +fun merge_act_box_tac i =
  35.256 +   REPEAT_DETERM (EVERY [etac box_conjE_act i, atac i,
  35.257 +                         eres_inst_tac [("'a","state * state")] box_thin i])
  35.258  
  35.259  end
  35.260 +*}
  35.261 +
  35.262 +(* rewrite rule to push universal quantification through box:
  35.263 +      (sigma |= [](! x. F x)) = (! x. (sigma |= []F x))
  35.264 +*)
  35.265 +lemmas all_box = allT [temp_unlift, symmetric, standard]
  35.266 +
  35.267 +lemma DmdOr: "|- (<>(F | G)) = (<>F | <>G)"
  35.268 +  apply (auto simp add: dmd_def split_box_conj [try_rewrite])
  35.269 +  apply (erule contrapos_np, tactic "merge_box_tac 1",
  35.270 +    fastsimp elim!: STL4E [temp_use])+
  35.271 +  done
  35.272 +
  35.273 +lemma exT: "|- (EX x. <>(F x)) = (<>(EX x. F x))"
  35.274 +  by (auto simp: dmd_def Not_Rex [try_rewrite] all_box [try_rewrite])
  35.275 +
  35.276 +lemmas ex_dmd = exT [temp_unlift, symmetric, standard]
  35.277 +
  35.278 +lemma STL4Edup: "!!sigma. [| sigma |= []A; sigma |= []F; |- F & []A --> G |] ==> sigma |= []G"
  35.279 +  apply (erule dup_boxE)
  35.280 +  apply (tactic "merge_box_tac 1")
  35.281 +  apply (erule STL4E)
  35.282 +  apply assumption
  35.283 +  done
  35.284 +
  35.285 +lemma DmdImpl2: 
  35.286 +    "!!sigma. [| sigma |= <>F; sigma |= [](F --> G) |] ==> sigma |= <>G"
  35.287 +  apply (unfold dmd_def)
  35.288 +  apply auto
  35.289 +  apply (erule notE)
  35.290 +  apply (tactic "merge_box_tac 1")
  35.291 +  apply (fastsimp elim!: STL4E [temp_use])
  35.292 +  done
  35.293 +
  35.294 +lemma InfImpl:
  35.295 +  assumes 1: "sigma |= []<>F"
  35.296 +    and 2: "sigma |= []G"
  35.297 +    and 3: "|- F & G --> H"
  35.298 +  shows "sigma |= []<>H"
  35.299 +  apply (insert 1 2)
  35.300 +  apply (erule_tac F = G in dup_boxE)
  35.301 +  apply (tactic "merge_box_tac 1")
  35.302 +  apply (fastsimp elim!: STL4E [temp_use] DmdImpl2 [temp_use] intro!: 3 [temp_use])
  35.303 +  done
  35.304 +
  35.305 +(* ------------------------ STL6 ------------------------------------------- *)
  35.306 +(* Used in the proof of STL6, but useful in itself. *)
  35.307 +lemma BoxDmd: "|- []F & <>G --> <>([]F & G)"
  35.308 +  apply (unfold dmd_def)
  35.309 +  apply clarsimp
  35.310 +  apply (erule dup_boxE)
  35.311 +  apply (tactic "merge_box_tac 1")
  35.312 +  apply (erule contrapos_np)
  35.313 +  apply (fastsimp elim!: STL4E [temp_use])
  35.314 +  done
  35.315 +
  35.316 +(* weaker than BoxDmd, but more polymorphic (and often just right) *)
  35.317 +lemma BoxDmd_simple: "|- []F & <>G --> <>(F & G)"
  35.318 +  apply (unfold dmd_def)
  35.319 +  apply clarsimp
  35.320 +  apply (tactic "merge_box_tac 1")
  35.321 +  apply (fastsimp elim!: notE STL4E [temp_use])
  35.322 +  done
  35.323 +
  35.324 +lemma BoxDmd2_simple: "|- []F & <>G --> <>(G & F)"
  35.325 +  apply (unfold dmd_def)
  35.326 +  apply clarsimp
  35.327 +  apply (tactic "merge_box_tac 1")
  35.328 +  apply (fastsimp elim!: notE STL4E [temp_use])
  35.329 +  done
  35.330 +
  35.331 +lemma DmdImpldup:
  35.332 +  assumes 1: "sigma |= []A"
  35.333 +    and 2: "sigma |= <>F"
  35.334 +    and 3: "|- []A & F --> G"
  35.335 +  shows "sigma |= <>G"
  35.336 +  apply (rule 2 [THEN 1 [THEN BoxDmd [temp_use]], THEN DmdImplE])
  35.337 +  apply (rule 3)
  35.338 +  done
  35.339 +
  35.340 +lemma STL6: "|- <>[]F & <>[]G --> <>[](F & G)"
  35.341 +  apply (auto simp: STL5 [temp_rewrite, symmetric])
  35.342 +  apply (drule linT [temp_use])
  35.343 +   apply assumption
  35.344 +  apply (erule thin_rl)
  35.345 +  apply (rule DmdDmd [temp_unlift, THEN iffD1])
  35.346 +  apply (erule disjE)
  35.347 +   apply (erule DmdImplE)
  35.348 +   apply (rule BoxDmd)
  35.349 +  apply (erule DmdImplE)
  35.350 +  apply auto
  35.351 +  apply (drule BoxDmd [temp_use])
  35.352 +   apply assumption
  35.353 +  apply (erule thin_rl)
  35.354 +  apply (fastsimp elim!: DmdImplE [temp_use])
  35.355 +  done
  35.356 +
  35.357 +
  35.358 +(* ------------------------ True / False ----------------------------------------- *)
  35.359 +section "Simplification of constants"
  35.360 +
  35.361 +lemma BoxConst: "|- ([]#P) = #P"
  35.362 +  apply (rule tempI)
  35.363 +  apply (cases P)
  35.364 +   apply (auto intro!: necT [temp_use] dest: STL2_gen [temp_use] simp: Init_simps)
  35.365 +  done
  35.366 +
  35.367 +lemma DmdConst: "|- (<>#P) = #P"
  35.368 +  apply (unfold dmd_def)
  35.369 +  apply (cases P)
  35.370 +  apply (simp_all add: BoxConst [try_rewrite])
  35.371 +  done
  35.372 +
  35.373 +lemmas temp_simps [temp_rewrite, simp] = BoxConst DmdConst
  35.374 +
  35.375 +(* Make these rewrites active by default *)
  35.376 +ML {*
  35.377 +val temp_css = temp_css addsimps2 (thms "temp_simps")
  35.378 +val temp_cs = op addss temp_css
  35.379 +*}
  35.380 +
  35.381 +
  35.382 +(* ------------------------ Further rewrites ----------------------------------------- *)
  35.383 +section "Further rewrites"
  35.384 +
  35.385 +lemma NotBox: "|- (~[]F) = (<>~F)"
  35.386 +  by (simp add: dmd_def)
  35.387 +
  35.388 +lemma NotDmd: "|- (~<>F) = ([]~F)"
  35.389 +  by (simp add: dmd_def)
  35.390 +
  35.391 +(* These are not declared by default, because they could be harmful,
  35.392 +   e.g. []F & ~[]F becomes []F & <>~F !! *)
  35.393 +lemmas more_temp_simps =
  35.394 +  STL3 [temp_rewrite] DmdDmd [temp_rewrite] NotBox [temp_rewrite] NotDmd [temp_rewrite]
  35.395 +  NotBox [temp_unlift, THEN eq_reflection]
  35.396 +  NotDmd [temp_unlift, THEN eq_reflection]
  35.397 +
  35.398 +lemma BoxDmdBox: "|- ([]<>[]F) = (<>[]F)"
  35.399 +  apply (auto dest!: STL2 [temp_use])
  35.400 +  apply (rule ccontr)
  35.401 +  apply (subgoal_tac "sigma |= <>[][]F & <>[]~[]F")
  35.402 +   apply (erule thin_rl)
  35.403 +   apply auto
  35.404 +    apply (drule STL6 [temp_use])
  35.405 +     apply assumption
  35.406 +    apply simp
  35.407 +   apply (simp_all add: more_temp_simps)
  35.408 +  done
  35.409 +
  35.410 +lemma DmdBoxDmd: "|- (<>[]<>F) = ([]<>F)"
  35.411 +  apply (unfold dmd_def)
  35.412 +  apply (auto simp: BoxDmdBox [unfolded dmd_def, try_rewrite])
  35.413 +  done
  35.414 +
  35.415 +lemmas more_temp_simps = more_temp_simps BoxDmdBox [temp_rewrite] DmdBoxDmd [temp_rewrite]
  35.416 +
  35.417 +
  35.418 +(* ------------------------ Miscellaneous ----------------------------------- *)
  35.419 +
  35.420 +lemma BoxOr: "!!sigma. [| sigma |= []F | []G |] ==> sigma |= [](F | G)"
  35.421 +  by (fastsimp elim!: STL4E [temp_use])
  35.422 +
  35.423 +(* "persistently implies infinitely often" *)
  35.424 +lemma DBImplBD: "|- <>[]F --> []<>F"
  35.425 +  apply clarsimp
  35.426 +  apply (rule ccontr)
  35.427 +  apply (simp add: more_temp_simps)
  35.428 +  apply (drule STL6 [temp_use])
  35.429 +   apply assumption
  35.430 +  apply simp
  35.431 +  done
  35.432 +
  35.433 +lemma BoxDmdDmdBox: "|- []<>F & <>[]G --> []<>(F & G)"
  35.434 +  apply clarsimp
  35.435 +  apply (rule ccontr)
  35.436 +  apply (unfold more_temp_simps)
  35.437 +  apply (drule STL6 [temp_use])
  35.438 +   apply assumption
  35.439 +  apply (subgoal_tac "sigma |= <>[]~F")
  35.440 +   apply (force simp: dmd_def)
  35.441 +  apply (fastsimp elim: DmdImplE [temp_use] STL4E [temp_use])
  35.442 +  done
  35.443 +
  35.444 +
  35.445 +(* ------------------------------------------------------------------------- *)
  35.446 +(***          TLA-specific theorems: primed formulas                       ***)
  35.447 +(* ------------------------------------------------------------------------- *)
  35.448 +section "priming"
  35.449 +
  35.450 +(* ------------------------ TLA2 ------------------------------------------- *)
  35.451 +lemma STL2_pr: "|- []P --> Init P & Init P`"
  35.452 +  by (fastsimp intro!: STL2_gen [temp_use] primeI [temp_use])
  35.453 +
  35.454 +(* Auxiliary lemma allows priming of boxed actions *)
  35.455 +lemma BoxPrime: "|- []P --> []($P & P$)"
  35.456 +  apply clarsimp
  35.457 +  apply (erule dup_boxE)
  35.458 +  apply (unfold boxInit_act)
  35.459 +  apply (erule STL4E)
  35.460 +  apply (auto simp: Init_simps dest!: STL2_pr [temp_use])
  35.461 +  done
  35.462 +
  35.463 +lemma TLA2:
  35.464 +  assumes "|- $P & P$ --> A"
  35.465 +  shows "|- []P --> []A"
  35.466 +  apply clarsimp
  35.467 +  apply (drule BoxPrime [temp_use])
  35.468 +  apply (auto simp: Init_stp_act_rev [try_rewrite] intro!: prems [temp_use]
  35.469 +    elim!: STL4E [temp_use])
  35.470 +  done
  35.471 +
  35.472 +lemma TLA2E: "[| sigma |= []P; |- $P & P$ --> A |] ==> sigma |= []A"
  35.473 +  by (erule (1) TLA2 [temp_use])
  35.474 +
  35.475 +lemma DmdPrime: "|- (<>P`) --> (<>P)"
  35.476 +  apply (unfold dmd_def)
  35.477 +  apply (fastsimp elim!: TLA2E [temp_use])
  35.478 +  done
  35.479 +
  35.480 +lemmas PrimeDmd = InitDmd_gen [temp_use, THEN DmdPrime [temp_use], standard]
  35.481 +
  35.482 +(* ------------------------ INV1, stable --------------------------------------- *)
  35.483 +section "stable, invariant"
  35.484 +
  35.485 +lemma ind_rule:
  35.486 +   "[| sigma |= []H; sigma |= Init P; |- H --> (Init P & ~[]F --> Init(P`) & F) |]  
  35.487 +    ==> sigma |= []F"
  35.488 +  apply (rule indT [temp_use])
  35.489 +   apply (erule (2) STL4E)
  35.490 +  done
  35.491 +
  35.492 +lemma box_stp_act: "|- ([]$P) = ([]P)"
  35.493 +  by (simp add: boxInit_act Init_simps)
  35.494 +
  35.495 +lemmas box_stp_actI = box_stp_act [temp_use, THEN iffD2, standard]
  35.496 +lemmas box_stp_actD = box_stp_act [temp_use, THEN iffD1, standard]
  35.497 +
  35.498 +lemmas more_temp_simps = box_stp_act [temp_rewrite] more_temp_simps
  35.499 +
  35.500 +lemma INV1: 
  35.501 +  "|- (Init P) --> (stable P) --> []P"
  35.502 +  apply (unfold stable_def boxInit_stp boxInit_act)
  35.503 +  apply clarsimp
  35.504 +  apply (erule ind_rule)
  35.505 +   apply (auto simp: Init_simps elim: ind_rule)
  35.506 +  done
  35.507 +
  35.508 +lemma StableT: 
  35.509 +    "!!P. |- $P & A --> P` ==> |- []A --> stable P"
  35.510 +  apply (unfold stable_def)
  35.511 +  apply (fastsimp elim!: STL4E [temp_use])
  35.512 +  done
  35.513 +
  35.514 +lemma Stable: "[| sigma |= []A; |- $P & A --> P` |] ==> sigma |= stable P"
  35.515 +  by (erule (1) StableT [temp_use])
  35.516 +
  35.517 +(* Generalization of INV1 *)
  35.518 +lemma StableBox: "|- (stable P) --> [](Init P --> []P)"
  35.519 +  apply (unfold stable_def)
  35.520 +  apply clarsimp
  35.521 +  apply (erule dup_boxE)
  35.522 +  apply (force simp: stable_def elim: STL4E [temp_use] INV1 [temp_use])
  35.523 +  done
  35.524 +
  35.525 +lemma DmdStable: "|- (stable P) & <>P --> <>[]P"
  35.526 +  apply clarsimp
  35.527 +  apply (rule DmdImpl2)
  35.528 +   prefer 2
  35.529 +   apply (erule StableBox [temp_use])
  35.530 +  apply (simp add: dmdInitD)
  35.531 +  done
  35.532 +
  35.533 +(* ---------------- (Semi-)automatic invariant tactics ---------------------- *)
  35.534 +
  35.535 +ML {*
  35.536 +local
  35.537 +  val INV1 = thm "INV1";
  35.538 +  val Stable = thm "Stable";
  35.539 +  val Init_stp = thm "Init_stp";
  35.540 +  val Init_act = thm "Init_act";
  35.541 +  val squareE = thm "squareE";
  35.542 +in
  35.543 +
  35.544 +(* inv_tac reduces goals of the form ... ==> sigma |= []P *)
  35.545 +fun inv_tac css = SELECT_GOAL
  35.546 +     (EVERY [auto_tac css,
  35.547 +             TRY (merge_box_tac 1),
  35.548 +             rtac (temp_use INV1) 1, (* fail if the goal is not a box *)
  35.549 +             TRYALL (etac Stable)]);
  35.550 +
  35.551 +(* auto_inv_tac applies inv_tac and then tries to attack the subgoals
  35.552 +   in simple cases it may be able to handle goals like |- MyProg --> []Inv.
  35.553 +   In these simple cases the simplifier seems to be more useful than the
  35.554 +   auto-tactic, which applies too much propositional logic and simplifies
  35.555 +   too late.
  35.556 +*)
  35.557 +fun auto_inv_tac ss = SELECT_GOAL
  35.558 +    ((inv_tac (claset(),ss) 1) THEN
  35.559 +     (TRYALL (action_simp_tac (ss addsimps [Init_stp, Init_act]) [] [squareE])));
  35.560 +end
  35.561 +*}
  35.562 +
  35.563 +lemma unless: "|- []($P --> P` | Q`) --> (stable P) | <>Q"
  35.564 +  apply (unfold dmd_def)
  35.565 +  apply (clarsimp dest!: BoxPrime [temp_use])
  35.566 +  apply (tactic "merge_box_tac 1")
  35.567 +  apply (erule contrapos_np)
  35.568 +  apply (fastsimp elim!: Stable [temp_use])
  35.569 +  done
  35.570 +
  35.571 +
  35.572 +(* --------------------- Recursive expansions --------------------------------------- *)
  35.573 +section "recursive expansions"
  35.574 +
  35.575 +(* Recursive expansions of [] and <> for state predicates *)
  35.576 +lemma BoxRec: "|- ([]P) = (Init P & []P`)"
  35.577 +  apply (auto intro!: STL2_gen [temp_use])
  35.578 +   apply (fastsimp elim!: TLA2E [temp_use])
  35.579 +  apply (auto simp: stable_def elim!: INV1 [temp_use] STL4E [temp_use])
  35.580 +  done
  35.581 +
  35.582 +lemma DmdRec: "|- (<>P) = (Init P | <>P`)"
  35.583 +  apply (unfold dmd_def BoxRec [temp_rewrite])
  35.584 +  apply (auto simp: Init_simps)
  35.585 +  done
  35.586 +
  35.587 +lemma DmdRec2: "!!sigma. [| sigma |= <>P; sigma |= []~P` |] ==> sigma |= Init P"
  35.588 +  apply (force simp: DmdRec [temp_rewrite] dmd_def)
  35.589 +  done
  35.590 +
  35.591 +lemma InfinitePrime: "|- ([]<>P) = ([]<>P`)"
  35.592 +  apply auto
  35.593 +   apply (rule classical)
  35.594 +   apply (rule DBImplBD [temp_use])
  35.595 +   apply (subgoal_tac "sigma |= <>[]P")
  35.596 +    apply (fastsimp elim!: DmdImplE [temp_use] TLA2E [temp_use])
  35.597 +   apply (subgoal_tac "sigma |= <>[] (<>P & []~P`)")
  35.598 +    apply (force simp: boxInit_stp [temp_use]
  35.599 +      elim!: DmdImplE [temp_use] STL4E [temp_use] DmdRec2 [temp_use])
  35.600 +   apply (force intro!: STL6 [temp_use] simp: more_temp_simps)
  35.601 +  apply (fastsimp intro: DmdPrime [temp_use] elim!: STL4E [temp_use])
  35.602 +  done
  35.603 +
  35.604 +lemma InfiniteEnsures:
  35.605 +  "[| sigma |= []N; sigma |= []<>A; |- A & N --> P` |] ==> sigma |= []<>P"
  35.606 +  apply (unfold InfinitePrime [temp_rewrite])
  35.607 +  apply (rule InfImpl)
  35.608 +    apply assumption+
  35.609 +  done
  35.610 +
  35.611 +(* ------------------------ fairness ------------------------------------------- *)
  35.612 +section "fairness"
  35.613 +
  35.614 +(* alternative definitions of fairness *)
  35.615 +lemma WF_alt: "|- WF(A)_v = ([]<>~Enabled(<A>_v) | []<><A>_v)"
  35.616 +  apply (unfold WF_def dmd_def)
  35.617 +  apply fastsimp
  35.618 +  done
  35.619 +
  35.620 +lemma SF_alt: "|- SF(A)_v = (<>[]~Enabled(<A>_v) | []<><A>_v)"
  35.621 +  apply (unfold SF_def dmd_def)
  35.622 +  apply fastsimp
  35.623 +  done
  35.624 +
  35.625 +(* theorems to "box" fairness conditions *)
  35.626 +lemma BoxWFI: "|- WF(A)_v --> []WF(A)_v"
  35.627 +  by (auto simp: WF_alt [try_rewrite] more_temp_simps intro!: BoxOr [temp_use])
  35.628 +
  35.629 +lemma WF_Box: "|- ([]WF(A)_v) = WF(A)_v"
  35.630 +  by (fastsimp intro!: BoxWFI [temp_use] dest!: STL2 [temp_use])
  35.631 +
  35.632 +lemma BoxSFI: "|- SF(A)_v --> []SF(A)_v"
  35.633 +  by (auto simp: SF_alt [try_rewrite] more_temp_simps intro!: BoxOr [temp_use])
  35.634 +
  35.635 +lemma SF_Box: "|- ([]SF(A)_v) = SF(A)_v"
  35.636 +  by (fastsimp intro!: BoxSFI [temp_use] dest!: STL2 [temp_use])
  35.637 +
  35.638 +lemmas more_temp_simps = more_temp_simps WF_Box [temp_rewrite] SF_Box [temp_rewrite]
  35.639 +
  35.640 +lemma SFImplWF: "|- SF(A)_v --> WF(A)_v"
  35.641 +  apply (unfold SF_def WF_def)
  35.642 +  apply (fastsimp dest!: DBImplBD [temp_use])
  35.643 +  done
  35.644 +
  35.645 +(* A tactic that "boxes" all fairness conditions. Apply more_temp_simps to "unbox". *)
  35.646 +ML {*
  35.647 +local
  35.648 +  val BoxWFI = thm "BoxWFI";
  35.649 +  val BoxSFI = thm "BoxSFI";
  35.650 +in 
  35.651 +val box_fair_tac = SELECT_GOAL (REPEAT (dresolve_tac [BoxWFI,BoxSFI] 1))
  35.652 +end
  35.653 +*}
  35.654 +
  35.655 +
  35.656 +(* ------------------------------ leads-to ------------------------------ *)
  35.657 +
  35.658 +section "~>"
  35.659 +
  35.660 +lemma leadsto_init: "|- (Init F) & (F ~> G) --> <>G"
  35.661 +  apply (unfold leadsto_def)
  35.662 +  apply (auto dest!: STL2 [temp_use])
  35.663 +  done
  35.664 +
  35.665 +(* |- F & (F ~> G) --> <>G *)
  35.666 +lemmas leadsto_init_temp = leadsto_init [where 'a = behavior, unfolded Init_simps, standard]
  35.667 +
  35.668 +lemma streett_leadsto: "|- ([]<>Init F --> []<>G) = (<>(F ~> G))"
  35.669 +  apply (unfold leadsto_def)
  35.670 +  apply auto
  35.671 +    apply (simp add: more_temp_simps)
  35.672 +    apply (fastsimp elim!: DmdImplE [temp_use] STL4E [temp_use])
  35.673 +   apply (fastsimp intro!: InitDmd [temp_use] elim!: STL4E [temp_use])
  35.674 +  apply (subgoal_tac "sigma |= []<><>G")
  35.675 +   apply (simp add: more_temp_simps)
  35.676 +  apply (drule BoxDmdDmdBox [temp_use])
  35.677 +   apply assumption
  35.678 +  apply (fastsimp elim!: DmdImplE [temp_use] STL4E [temp_use])
  35.679 +  done
  35.680 +
  35.681 +lemma leadsto_infinite: "|- []<>F & (F ~> G) --> []<>G"
  35.682 +  apply clarsimp
  35.683 +  apply (erule InitDmd [temp_use, THEN streett_leadsto [temp_unlift, THEN iffD2, THEN mp]])
  35.684 +  apply (simp add: dmdInitD)
  35.685 +  done
  35.686 +
  35.687 +(* In particular, strong fairness is a Streett condition. The following
  35.688 +   rules are sometimes easier to use than WF2 or SF2 below.
  35.689 +*)
  35.690 +lemma leadsto_SF: "|- (Enabled(<A>_v) ~> <A>_v) --> SF(A)_v"
  35.691 +  apply (unfold SF_def)
  35.692 +  apply (clarsimp elim!: leadsto_infinite [temp_use])
  35.693 +  done
  35.694 +
  35.695 +lemma leadsto_WF: "|- (Enabled(<A>_v) ~> <A>_v) --> WF(A)_v"
  35.696 +  by (clarsimp intro!: SFImplWF [temp_use] leadsto_SF [temp_use])
  35.697 +
  35.698 +(* introduce an invariant into the proof of a leadsto assertion.
  35.699 +   []I --> ((P ~> Q)  =  (P /\ I ~> Q))
  35.700 +*)
  35.701 +lemma INV_leadsto: "|- []I & (P & I ~> Q) --> (P ~> Q)"
  35.702 +  apply (unfold leadsto_def)
  35.703 +  apply clarsimp
  35.704 +  apply (erule STL4Edup)
  35.705 +   apply assumption
  35.706 +  apply (auto simp: Init_simps dest!: STL2_gen [temp_use])
  35.707 +  done
  35.708 +
  35.709 +lemma leadsto_classical: "|- (Init F & []~G ~> G) --> (F ~> G)"
  35.710 +  apply (unfold leadsto_def dmd_def)
  35.711 +  apply (force simp: Init_simps elim!: STL4E [temp_use])
  35.712 +  done
  35.713 +
  35.714 +lemma leadsto_false: "|- (F ~> #False) = ([]~F)"
  35.715 +  apply (unfold leadsto_def)
  35.716 +  apply (simp add: boxNotInitD)
  35.717 +  done
  35.718 +
  35.719 +lemma leadsto_exists: "|- ((EX x. F x) ~> G) = (ALL x. (F x ~> G))"
  35.720 +  apply (unfold leadsto_def)
  35.721 +  apply (auto simp: allT [try_rewrite] Init_simps elim!: STL4E [temp_use])
  35.722 +  done
  35.723 +
  35.724 +(* basic leadsto properties, cf. Unity *)
  35.725 +
  35.726 +lemma ImplLeadsto_gen: "|- [](Init F --> Init G) --> (F ~> G)"
  35.727 +  apply (unfold leadsto_def)
  35.728 +  apply (auto intro!: InitDmd_gen [temp_use]
  35.729 +    elim!: STL4E_gen [temp_use] simp: Init_simps)
  35.730 +  done
  35.731 +
  35.732 +lemmas ImplLeadsto = ImplLeadsto_gen [where 'a = behavior and 'b = behavior,
  35.733 +  unfolded Init_simps, standard]
  35.734 +
  35.735 +lemma ImplLeadsto_simple: "!!F G. |- F --> G ==> |- F ~> G"
  35.736 +  by (auto simp: Init_def intro!: ImplLeadsto_gen [temp_use] necT [temp_use])
  35.737 +
  35.738 +lemma EnsuresLeadsto:
  35.739 +  assumes "|- A & $P --> Q`"
  35.740 +  shows "|- []A --> (P ~> Q)"
  35.741 +  apply (unfold leadsto_def)
  35.742 +  apply (clarsimp elim!: INV_leadsto [temp_use])
  35.743 +  apply (erule STL4E_gen)
  35.744 +  apply (auto simp: Init_defs intro!: PrimeDmd [temp_use] assms [temp_use])
  35.745 +  done
  35.746 +
  35.747 +lemma EnsuresLeadsto2: "|- []($P --> Q`) --> (P ~> Q)"
  35.748 +  apply (unfold leadsto_def)
  35.749 +  apply clarsimp
  35.750 +  apply (erule STL4E_gen)
  35.751 +  apply (auto simp: Init_simps intro!: PrimeDmd [temp_use])
  35.752 +  done
  35.753 +
  35.754 +lemma ensures:
  35.755 +  assumes 1: "|- $P & N --> P` | Q`"
  35.756 +    and 2: "|- ($P & N) & A --> Q`"
  35.757 +  shows "|- []N & []([]P --> <>A) --> (P ~> Q)"
  35.758 +  apply (unfold leadsto_def)
  35.759 +  apply clarsimp
  35.760 +  apply (erule STL4Edup)
  35.761 +   apply assumption
  35.762 +  apply clarsimp
  35.763 +  apply (subgoal_tac "sigmaa |= [] ($P --> P` | Q`) ")
  35.764 +   apply (drule unless [temp_use])
  35.765 +   apply (clarsimp dest!: INV1 [temp_use])
  35.766 +  apply (rule 2 [THEN DmdImpl, temp_use, THEN DmdPrime [temp_use]])
  35.767 +   apply (force intro!: BoxDmd_simple [temp_use]
  35.768 +     simp: split_box_conj [try_rewrite] box_stp_act [try_rewrite])
  35.769 +  apply (force elim: STL4E [temp_use] dest: 1 [temp_use])
  35.770 +  done
  35.771 +
  35.772 +lemma ensures_simple:
  35.773 +  "[| |- $P & N --> P` | Q`;  
  35.774 +      |- ($P & N) & A --> Q`  
  35.775 +   |] ==> |- []N & []<>A --> (P ~> Q)"
  35.776 +  apply clarsimp
  35.777 +  apply (erule (2) ensures [temp_use])
  35.778 +  apply (force elim!: STL4E [temp_use])
  35.779 +  done
  35.780 +
  35.781 +lemma EnsuresInfinite:
  35.782 +    "[| sigma |= []<>P; sigma |= []A; |- A & $P --> Q` |] ==> sigma |= []<>Q"
  35.783 +  apply (erule leadsto_infinite [temp_use])
  35.784 +  apply (erule EnsuresLeadsto [temp_use])
  35.785 +  apply assumption
  35.786 +  done
  35.787 +
  35.788 +
  35.789 +(*** Gronning's lattice rules (taken from TLP) ***)
  35.790 +section "Lattice rules"
  35.791 +
  35.792 +lemma LatticeReflexivity: "|- F ~> F"
  35.793 +  apply (unfold leadsto_def)
  35.794 +  apply (rule necT InitDmd_gen)+
  35.795 +  done
  35.796 +
  35.797 +lemma LatticeTransitivity: "|- (G ~> H) & (F ~> G) --> (F ~> H)"
  35.798 +  apply (unfold leadsto_def)
  35.799 +  apply clarsimp
  35.800 +  apply (erule dup_boxE) (* [][] (Init G --> H) *)
  35.801 +  apply (tactic "merge_box_tac 1")
  35.802 +  apply (clarsimp elim!: STL4E [temp_use])
  35.803 +  apply (rule dup_dmdD)
  35.804 +  apply (subgoal_tac "sigmaa |= <>Init G")
  35.805 +   apply (erule DmdImpl2)
  35.806 +   apply assumption
  35.807 +  apply (simp add: dmdInitD)
  35.808 +  done
  35.809 +
  35.810 +lemma LatticeDisjunctionElim1: "|- (F | G ~> H) --> (F ~> H)"
  35.811 +  apply (unfold leadsto_def)
  35.812 +  apply (auto simp: Init_simps elim!: STL4E [temp_use])
  35.813 +  done
  35.814 +
  35.815 +lemma LatticeDisjunctionElim2: "|- (F | G ~> H) --> (G ~> H)"
  35.816 +  apply (unfold leadsto_def)
  35.817 +  apply (auto simp: Init_simps elim!: STL4E [temp_use])
  35.818 +  done
  35.819 +
  35.820 +lemma LatticeDisjunctionIntro: "|- (F ~> H) & (G ~> H) --> (F | G ~> H)"
  35.821 +  apply (unfold leadsto_def)
  35.822 +  apply clarsimp
  35.823 +  apply (tactic "merge_box_tac 1")
  35.824 +  apply (auto simp: Init_simps elim!: STL4E [temp_use])
  35.825 +  done
  35.826 +
  35.827 +lemma LatticeDisjunction: "|- (F | G ~> H) = ((F ~> H) & (G ~> H))"
  35.828 +  by (auto intro: LatticeDisjunctionIntro [temp_use]
  35.829 +    LatticeDisjunctionElim1 [temp_use]
  35.830 +    LatticeDisjunctionElim2 [temp_use])
  35.831 +
  35.832 +lemma LatticeDiamond: "|- (A ~> B | C) & (B ~> D) & (C ~> D) --> (A ~> D)"
  35.833 +  apply clarsimp
  35.834 +  apply (subgoal_tac "sigma |= (B | C) ~> D")
  35.835 +  apply (erule_tac G = "LIFT (B | C)" in LatticeTransitivity [temp_use])
  35.836 +   apply (fastsimp intro!: LatticeDisjunctionIntro [temp_use])+
  35.837 +  done
  35.838 +
  35.839 +lemma LatticeTriangle: "|- (A ~> D | B) & (B ~> D) --> (A ~> D)"
  35.840 +  apply clarsimp
  35.841 +  apply (subgoal_tac "sigma |= (D | B) ~> D")
  35.842 +   apply (erule_tac G = "LIFT (D | B)" in LatticeTransitivity [temp_use])
  35.843 +  apply assumption
  35.844 +  apply (auto intro: LatticeDisjunctionIntro [temp_use] LatticeReflexivity [temp_use])
  35.845 +  done
  35.846 +
  35.847 +lemma LatticeTriangle2: "|- (A ~> B | D) & (B ~> D) --> (A ~> D)"
  35.848 +  apply clarsimp
  35.849 +  apply (subgoal_tac "sigma |= B | D ~> D")
  35.850 +   apply (erule_tac G = "LIFT (B | D)" in LatticeTransitivity [temp_use])
  35.851 +   apply assumption
  35.852 +  apply (auto intro: LatticeDisjunctionIntro [temp_use] LatticeReflexivity [temp_use])
  35.853 +  done
  35.854 +
  35.855 +(*** Lamport's fairness rules ***)
  35.856 +section "Fairness rules"
  35.857 +
  35.858 +lemma WF1:
  35.859 +  "[| |- $P & N  --> P` | Q`;    
  35.860 +      |- ($P & N) & <A>_v --> Q`;    
  35.861 +      |- $P & N --> $(Enabled(<A>_v)) |]    
  35.862 +  ==> |- []N & WF(A)_v --> (P ~> Q)"
  35.863 +  apply (clarsimp dest!: BoxWFI [temp_use])
  35.864 +  apply (erule (2) ensures [temp_use])
  35.865 +  apply (erule (1) STL4Edup)
  35.866 +  apply (clarsimp simp: WF_def)
  35.867 +  apply (rule STL2 [temp_use])
  35.868 +  apply (clarsimp elim!: mp intro!: InitDmd [temp_use])
  35.869 +  apply (erule STL4 [temp_use, THEN box_stp_actD [temp_use]])
  35.870 +  apply (simp add: split_box_conj box_stp_actI)
  35.871 +  done
  35.872 +
  35.873 +(* Sometimes easier to use; designed for action B rather than state predicate Q *)
  35.874 +lemma WF_leadsto:
  35.875 +  assumes 1: "|- N & $P --> $Enabled (<A>_v)"
  35.876 +    and 2: "|- N & <A>_v --> B"
  35.877 +    and 3: "|- [](N & [~A]_v) --> stable P"
  35.878 +  shows "|- []N & WF(A)_v --> (P ~> B)"
  35.879 +  apply (unfold leadsto_def)
  35.880 +  apply (clarsimp dest!: BoxWFI [temp_use])
  35.881 +  apply (erule (1) STL4Edup)
  35.882 +  apply clarsimp
  35.883 +  apply (rule 2 [THEN DmdImpl, temp_use])
  35.884 +  apply (rule BoxDmd_simple [temp_use])
  35.885 +   apply assumption
  35.886 +  apply (rule classical)
  35.887 +  apply (rule STL2 [temp_use])
  35.888 +  apply (clarsimp simp: WF_def elim!: mp intro!: InitDmd [temp_use])
  35.889 +  apply (rule 1 [THEN STL4, temp_use, THEN box_stp_actD])
  35.890 +  apply (simp (no_asm_simp) add: split_box_conj [try_rewrite] box_stp_act [try_rewrite])
  35.891 +  apply (erule INV1 [temp_use])
  35.892 +  apply (rule 3 [temp_use])
  35.893 +  apply (simp add: split_box_conj [try_rewrite] NotDmd [temp_use] not_angle [try_rewrite])
  35.894 +  done
  35.895 +
  35.896 +lemma SF1:
  35.897 +  "[| |- $P & N  --> P` | Q`;    
  35.898 +      |- ($P & N) & <A>_v --> Q`;    
  35.899 +      |- []P & []N & []F --> <>Enabled(<A>_v) |]    
  35.900 +  ==> |- []N & SF(A)_v & []F --> (P ~> Q)"
  35.901 +  apply (clarsimp dest!: BoxSFI [temp_use])
  35.902 +  apply (erule (2) ensures [temp_use])
  35.903 +  apply (erule_tac F = F in dup_boxE)
  35.904 +  apply (tactic "merge_temp_box_tac 1")
  35.905 +  apply (erule STL4Edup)
  35.906 +  apply assumption
  35.907 +  apply (clarsimp simp: SF_def)
  35.908 +  apply (rule STL2 [temp_use])
  35.909 +  apply (erule mp)
  35.910 +  apply (erule STL4 [temp_use])
  35.911 +  apply (simp add: split_box_conj [try_rewrite] STL3 [try_rewrite])
  35.912 +  done
  35.913 +
  35.914 +lemma WF2:
  35.915 +  assumes 1: "|- N & <B>_f --> <M>_g"
  35.916 +    and 2: "|- $P & P` & <N & A>_f --> B"
  35.917 +    and 3: "|- P & Enabled(<M>_g) --> Enabled(<A>_f)"
  35.918 +    and 4: "|- [](N & [~B]_f) & WF(A)_f & []F & <>[]Enabled(<M>_g) --> <>[]P"
  35.919 +  shows "|- []N & WF(A)_f & []F --> WF(M)_g"
  35.920 +  apply (clarsimp dest!: BoxWFI [temp_use] BoxDmdBox [temp_use, THEN iffD2]
  35.921 +    simp: WF_def [where A = M])
  35.922 +  apply (erule_tac F = F in dup_boxE)
  35.923 +  apply (tactic "merge_temp_box_tac 1")
  35.924 +  apply (erule STL4Edup)
  35.925 +   apply assumption
  35.926 +  apply (clarsimp intro!: BoxDmd_simple [temp_use, THEN 1 [THEN DmdImpl, temp_use]])
  35.927 +  apply (rule classical)
  35.928 +  apply (subgoal_tac "sigmaa |= <> (($P & P` & N) & <A>_f)")
  35.929 +   apply (force simp: angle_def intro!: 2 [temp_use] elim!: DmdImplE [temp_use])
  35.930 +  apply (rule BoxDmd_simple [THEN DmdImpl, unfolded DmdDmd [temp_rewrite], temp_use])
  35.931 +  apply (simp add: NotDmd [temp_use] not_angle [try_rewrite])
  35.932 +  apply (tactic "merge_act_box_tac 1")
  35.933 +  apply (frule 4 [temp_use])
  35.934 +     apply assumption+
  35.935 +  apply (drule STL6 [temp_use])
  35.936 +   apply assumption
  35.937 +  apply (erule_tac V = "sigmaa |= <>[]P" in thin_rl)
  35.938 +  apply (erule_tac V = "sigmaa |= []F" in thin_rl)
  35.939 +  apply (drule BoxWFI [temp_use])
  35.940 +  apply (erule_tac F = "ACT N & [~B]_f" in dup_boxE)
  35.941 +  apply (tactic "merge_temp_box_tac 1")
  35.942 +  apply (erule DmdImpldup)
  35.943 +   apply assumption
  35.944 +  apply (auto simp: split_box_conj [try_rewrite] STL3 [try_rewrite]
  35.945 +    WF_Box [try_rewrite] box_stp_act [try_rewrite])
  35.946 +   apply (force elim!: TLA2E [where P = P, temp_use])
  35.947 +  apply (rule STL2 [temp_use])
  35.948 +  apply (force simp: WF_def split_box_conj [try_rewrite]
  35.949 +    elim!: mp intro!: InitDmd [temp_use] 3 [THEN STL4, temp_use])
  35.950 +  done
  35.951 +
  35.952 +lemma SF2:
  35.953 +  assumes 1: "|- N & <B>_f --> <M>_g"
  35.954 +    and 2: "|- $P & P` & <N & A>_f --> B"
  35.955 +    and 3: "|- P & Enabled(<M>_g) --> Enabled(<A>_f)"
  35.956 +    and 4: "|- [](N & [~B]_f) & SF(A)_f & []F & []<>Enabled(<M>_g) --> <>[]P"
  35.957 +  shows "|- []N & SF(A)_f & []F --> SF(M)_g"
  35.958 +  apply (clarsimp dest!: BoxSFI [temp_use] simp: 2 [try_rewrite] SF_def [where A = M])
  35.959 +  apply (erule_tac F = F in dup_boxE)
  35.960 +  apply (erule_tac F = "TEMP <>Enabled (<M>_g) " in dup_boxE)
  35.961 +  apply (tactic "merge_temp_box_tac 1")
  35.962 +  apply (erule STL4Edup)
  35.963 +   apply assumption
  35.964 +  apply (clarsimp intro!: BoxDmd_simple [temp_use, THEN 1 [THEN DmdImpl, temp_use]])
  35.965 +  apply (rule classical)
  35.966 +  apply (subgoal_tac "sigmaa |= <> (($P & P` & N) & <A>_f)")
  35.967 +   apply (force simp: angle_def intro!: 2 [temp_use] elim!: DmdImplE [temp_use])
  35.968 +  apply (rule BoxDmd_simple [THEN DmdImpl, unfolded DmdDmd [temp_rewrite], temp_use])
  35.969 +  apply (simp add: NotDmd [temp_use] not_angle [try_rewrite])
  35.970 +  apply (tactic "merge_act_box_tac 1")
  35.971 +  apply (frule 4 [temp_use])
  35.972 +     apply assumption+
  35.973 +  apply (erule_tac V = "sigmaa |= []F" in thin_rl)
  35.974 +  apply (drule BoxSFI [temp_use])
  35.975 +  apply (erule_tac F = "TEMP <>Enabled (<M>_g)" in dup_boxE)
  35.976 +  apply (erule_tac F = "ACT N & [~B]_f" in dup_boxE)
  35.977 +  apply (tactic "merge_temp_box_tac 1")
  35.978 +  apply (erule DmdImpldup)
  35.979 +   apply assumption
  35.980 +  apply (auto simp: split_box_conj [try_rewrite] STL3 [try_rewrite]
  35.981 +    SF_Box [try_rewrite] box_stp_act [try_rewrite])
  35.982 +   apply (force elim!: TLA2E [where P = P, temp_use])
  35.983 +  apply (rule STL2 [temp_use])
  35.984 +  apply (force simp: SF_def split_box_conj [try_rewrite]
  35.985 +    elim!: mp InfImpl [temp_use] intro!: 3 [temp_use])
  35.986 +  done
  35.987 +
  35.988 +(* ------------------------------------------------------------------------- *)
  35.989 +(***           Liveness proofs by well-founded orderings                   ***)
  35.990 +(* ------------------------------------------------------------------------- *)
  35.991 +section "Well-founded orderings"
  35.992 +
  35.993 +lemma wf_leadsto:
  35.994 +  assumes 1: "wf r"
  35.995 +    and 2: "!!x. sigma |= F x ~> (G | (EX y. #((y,x):r) & F y))    "
  35.996 +  shows "sigma |= F x ~> G"
  35.997 +  apply (rule 1 [THEN wf_induct])
  35.998 +  apply (rule LatticeTriangle [temp_use])
  35.999 +   apply (rule 2)
 35.1000 +  apply (auto simp: leadsto_exists [try_rewrite])
 35.1001 +  apply (case_tac "(y,x) :r")
 35.1002 +   apply force
 35.1003 +  apply (force simp: leadsto_def Init_simps intro!: necT [temp_use])
 35.1004 +  done
 35.1005 +
 35.1006 +(* If r is well-founded, state function v cannot decrease forever *)
 35.1007 +lemma wf_not_box_decrease: "!!r. wf r ==> |- [][ (v`, $v) : #r ]_v --> <>[][#False]_v"
 35.1008 +  apply clarsimp
 35.1009 +  apply (rule ccontr)
 35.1010 +  apply (subgoal_tac "sigma |= (EX x. v=#x) ~> #False")
 35.1011 +   apply (drule leadsto_false [temp_use, THEN iffD1, THEN STL2_gen [temp_use]])
 35.1012 +   apply (force simp: Init_defs)
 35.1013 +  apply (clarsimp simp: leadsto_exists [try_rewrite] not_square [try_rewrite] more_temp_simps)
 35.1014 +  apply (erule wf_leadsto)
 35.1015 +  apply (rule ensures_simple [temp_use])
 35.1016 +     apply (tactic "TRYALL atac")
 35.1017 +   apply (auto simp: square_def angle_def)
 35.1018 +  done
 35.1019 +
 35.1020 +(* "wf r  ==>  |- <>[][ (v`, $v) : #r ]_v --> <>[][#False]_v" *)
 35.1021 +lemmas wf_not_dmd_box_decrease =
 35.1022 +  wf_not_box_decrease [THEN DmdImpl, unfolded more_temp_simps, standard]
 35.1023 +
 35.1024 +(* If there are infinitely many steps where v decreases, then there
 35.1025 +   have to be infinitely many non-stuttering steps where v doesn't decrease.
 35.1026 +*)
 35.1027 +lemma wf_box_dmd_decrease:
 35.1028 +  assumes 1: "wf r"
 35.1029 +  shows "|- []<>((v`, $v) : #r) --> []<><(v`, $v) ~: #r>_v"
 35.1030 +  apply clarsimp
 35.1031 +  apply (rule ccontr)
 35.1032 +  apply (simp add: not_angle [try_rewrite] more_temp_simps)
 35.1033 +  apply (drule 1 [THEN wf_not_dmd_box_decrease [temp_use]])
 35.1034 +  apply (drule BoxDmdDmdBox [temp_use])
 35.1035 +   apply assumption
 35.1036 +  apply (subgoal_tac "sigma |= []<> ((#False) ::action)")
 35.1037 +   apply force
 35.1038 +  apply (erule STL4E)
 35.1039 +  apply (rule DmdImpl)
 35.1040 +  apply (force intro: 1 [THEN wf_irrefl, temp_use])
 35.1041 +  done
 35.1042 +
 35.1043 +(* In particular, for natural numbers, if n decreases infinitely often
 35.1044 +   then it has to increase infinitely often.
 35.1045 +*)
 35.1046 +lemma nat_box_dmd_decrease: "!!n::nat stfun. |- []<>(n` < $n) --> []<>($n < n`)"
 35.1047 +  apply clarsimp
 35.1048 +  apply (subgoal_tac "sigma |= []<><~ ((n`,$n) : #less_than) >_n")
 35.1049 +   apply (erule thin_rl)
 35.1050 +   apply (erule STL4E)
 35.1051 +   apply (rule DmdImpl)
 35.1052 +   apply (clarsimp simp: angle_def [try_rewrite])
 35.1053 +  apply (rule wf_box_dmd_decrease [temp_use])
 35.1054 +   apply (auto elim!: STL4E [temp_use] DmdImplE [temp_use])
 35.1055 +  done
 35.1056 +
 35.1057 +
 35.1058 +(* ------------------------------------------------------------------------- *)
 35.1059 +(***           Flexible quantification over state variables                ***)
 35.1060 +(* ------------------------------------------------------------------------- *)
 35.1061 +section "Flexible quantification"
 35.1062 +
 35.1063 +lemma aallI:
 35.1064 +  assumes 1: "basevars vs"
 35.1065 +    and 2: "(!!x. basevars (x,vs) ==> sigma |= F x)"
 35.1066 +  shows "sigma |= (AALL x. F x)"
 35.1067 +  by (auto simp: aall_def elim!: eexE [temp_use] intro!: 1 dest!: 2 [temp_use])
 35.1068 +
 35.1069 +lemma aallE: "|- (AALL x. F x) --> F x"
 35.1070 +  apply (unfold aall_def)
 35.1071 +  apply clarsimp
 35.1072 +  apply (erule contrapos_np)
 35.1073 +  apply (force intro!: eexI [temp_use])
 35.1074 +  done
 35.1075 +
 35.1076 +(* monotonicity of quantification *)
 35.1077 +lemma eex_mono:
 35.1078 +  assumes 1: "sigma |= EEX x. F x"
 35.1079 +    and 2: "!!x. sigma |= F x --> G x"
 35.1080 +  shows "sigma |= EEX x. G x"
 35.1081 +  apply (rule unit_base [THEN 1 [THEN eexE]])
 35.1082 +  apply (rule eexI [temp_use])
 35.1083 +  apply (erule 2 [unfolded intensional_rews, THEN mp])
 35.1084 +  done
 35.1085 +
 35.1086 +lemma aall_mono:
 35.1087 +  assumes 1: "sigma |= AALL x. F(x)"
 35.1088 +    and 2: "!!x. sigma |= F(x) --> G(x)"
 35.1089 +  shows "sigma |= AALL x. G(x)"
 35.1090 +  apply (rule unit_base [THEN aallI])
 35.1091 +  apply (rule 2 [unfolded intensional_rews, THEN mp])
 35.1092 +  apply (rule 1 [THEN aallE [temp_use]])
 35.1093 +  done
 35.1094 +
 35.1095 +(* Derived history introduction rule *)
 35.1096 +lemma historyI:
 35.1097 +  assumes 1: "sigma |= Init I"
 35.1098 +    and 2: "sigma |= []N"
 35.1099 +    and 3: "basevars vs"
 35.1100 +    and 4: "!!h. basevars(h,vs) ==> |- I & h = ha --> HI h"
 35.1101 +    and 5: "!!h s t. [| basevars(h,vs); N (s,t); h t = hb (h s) (s,t) |] ==> HN h (s,t)"
 35.1102 +  shows "sigma |= EEX h. Init (HI h) & [](HN h)"
 35.1103 +  apply (rule history [temp_use, THEN eexE])
 35.1104 +  apply (rule 3)
 35.1105 +  apply (rule eexI [temp_use])
 35.1106 +  apply clarsimp
 35.1107 +  apply (rule conjI)
 35.1108 +   prefer 2
 35.1109 +   apply (insert 2)
 35.1110 +   apply (tactic "merge_box_tac 1")
 35.1111 +   apply (force elim!: STL4E [temp_use] 5 [temp_use])
 35.1112 +  apply (insert 1)
 35.1113 +  apply (force simp: Init_defs elim!: 4 [temp_use])
 35.1114 +  done
 35.1115 +
 35.1116 +(* ----------------------------------------------------------------------
 35.1117 +   example of a history variable: existence of a clock
 35.1118 +*)
 35.1119 +
 35.1120 +lemma "|- EEX h. Init(h = #True) & [](h` = (~$h))"
 35.1121 +  apply (rule tempI)
 35.1122 +  apply (rule historyI)
 35.1123 +  apply (force simp: Init_defs intro!: unit_base [temp_use] necT [temp_use])+
 35.1124 +  done
 35.1125 +
 35.1126 +end
 35.1127 +