A formalization of TLA in HOL -- by Stephan Merz;
authorwenzelm
Wed Oct 08 11:50:33 1997 +0200 (1997-10-08)
changeset 380782a99b090d9d
parent 3806 f371115aed37
child 3808 8489375c6198
A formalization of TLA in HOL -- by Stephan Merz;
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/Inc/Pcount.thy
src/HOL/TLA/IntLemmas.ML
src/HOL/TLA/Intensional.ML
src/HOL/TLA/Intensional.thy
src/HOL/TLA/Memory/MIParameters.thy
src/HOL/TLA/Memory/MIlive.ML
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/README.html
src/HOL/TLA/ROOT.ML
src/HOL/TLA/Stfun.ML
src/HOL/TLA/Stfun.thy
src/HOL/TLA/TLA.ML
src/HOL/TLA/TLA.thy
src/HOL/TLA/cladata.ML
src/HOL/TLA/hypsubst.ML
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/HOL/TLA/Action.ML	Wed Oct 08 11:50:33 1997 +0200
     1.3 @@ -0,0 +1,356 @@
     1.4 +(* 
     1.5 +    File:	 Action.ML
     1.6 +    Author:      Stephan Merz
     1.7 +    Copyright:   1997 University of Munich
     1.8 +
     1.9 +Lemmas and tactics for TLA actions.
    1.10 +*)
    1.11 +
    1.12 +val act_rews = [pairSF_def RS eq_reflection,unl_before,unl_after,unchanged_def,
    1.13 +                pr_con,pr_before,pr_lift,pr_lift2,pr_lift3,pr_all,pr_ex];
    1.14 +
    1.15 +val action_rews = act_rews @ intensional_rews;
    1.16 +
    1.17 +qed_goal "actionI" Action.thy "(!!s t. ([[s,t]] |= A)) ==> A"
    1.18 +  (fn [prem] => [REPEAT (resolve_tac [prem,intI,state2_ext] 1)]);
    1.19 +
    1.20 +qed_goal "actionD" Action.thy "A ==> ([[s,t]] |= A)"
    1.21 +  (fn [prem] => [REPEAT (resolve_tac [prem,intD] 1)]);
    1.22 +
    1.23 +
    1.24 +
    1.25 +(* ================ Functions to "unlift" action theorems into HOL rules ================ *)
    1.26 +
    1.27 +(* Basic unlifting introduces a world parameter and applies basic rewrites, e.g.
    1.28 +   A .= B    gets   ([[s,t]] |= A) = ([[s,t]] |= B)
    1.29 +   A .-> B   gets   ([[s,t]] |= A) --> ([[s,t]] |= B)
    1.30 +*)
    1.31 +fun action_unlift th = rewrite_rule action_rews (th RS actionD);
    1.32 +
    1.33 +(* A .-> B   becomes   A [[s,t]] ==> B [[s,t]] *)
    1.34 +fun action_mp th = zero_var_indexes ((action_unlift th) RS mp);
    1.35 +
    1.36 +(* A .-> B   becomes   [| A[[s,t]]; B[[s,t]] ==> R |] ==> R 
    1.37 +   so that it can be used as an elimination rule
    1.38 +*)
    1.39 +fun action_impE th = zero_var_indexes ((action_unlift th) RS impE);
    1.40 +
    1.41 +(* A .& B .-> C  becomes  [| A[[s,t]]; B[[s,t]] |] ==> C[[s,t]] *)
    1.42 +fun action_conjmp th = zero_var_indexes (conjI RS (action_mp th));
    1.43 +
    1.44 +(* A .& B .-> C  becomes  [| A[[s,t]]; B[[s,t]]; (C[[s,t]] ==> R) |] ==> R *)
    1.45 +fun action_conjimpE th = zero_var_indexes (conjI RS (action_impE th));
    1.46 +
    1.47 +(* Turn  A .= B  into meta-level rewrite rule  A == B *)
    1.48 +fun action_rewrite th = (rewrite_rule action_rews (th RS inteq_reflection));
    1.49 +
    1.50 +(* ===================== Update simpset and classical prover ============================= *)
    1.51 +
    1.52 +(* Make the simplifier use action_unlift rather than int_unlift 
    1.53 +   when action simplifications are added.
    1.54 +*)
    1.55 +fun maybe_unlift th =
    1.56 +    (case concl_of th of
    1.57 +         Const("TrueInt",_) $ p 
    1.58 +           => (action_unlift th
    1.59 +                  handle _ => int_unlift th)
    1.60 +       | _ => th);
    1.61 +
    1.62 +simpset := !simpset setmksimps ((mksimps mksimps_pairs) o maybe_unlift);
    1.63 +
    1.64 +(* make act_rews be always active -- intensional_rews has been added before *)
    1.65 +Addsimps act_rews;
    1.66 +
    1.67 +use "cladata.ML";        (* local version! *)
    1.68 +
    1.69 +(* ================================ action_simp_tac ================================== *)
    1.70 +
    1.71 +(* A dumb simplification tactic with just a little first-order logic:
    1.72 +   should plug in only "very safe" rules that can be applied blindly.
    1.73 +   Note that it applies whatever simplifications are currently active.
    1.74 +*)
    1.75 +fun action_simp_tac ss intros elims i =
    1.76 +    (asm_full_simp_tac 
    1.77 +         (ss setloop ((resolve_tac (intros @ [refl,impI,conjI,actionI,allI]))
    1.78 +		      ORELSE' (eresolve_tac (elims @ [conjE,disjE,exE_prop]))))
    1.79 +         i);
    1.80 +(* default version without additional plug-in rules *)
    1.81 +fun Action_simp_tac i = (action_simp_tac (!simpset) [] [] i);
    1.82 +
    1.83 +
    1.84 +(* ==================== Simplification of abstractions ==================== *)
    1.85 +
    1.86 +(* Somewhat obscure simplifications, rarely necessary to get rid
    1.87 +   of abstractions that may be introduced by higher-order unification.
    1.88 +*)
    1.89 +
    1.90 +qed_goal "pr_con_abs" Action.thy "(%w. c)` .= #c"
    1.91 +  (fn _ => [rtac actionI 1,
    1.92 +            rewrite_goals_tac (con_abs::action_rews),
    1.93 +            rtac refl 1
    1.94 +           ]);
    1.95 +
    1.96 +qed_goal "pr_lift_abs" Action.thy "(%w. f(x w))` .= f[x`]"
    1.97 +  (fn _ => [rtac actionI 1,
    1.98 +              (* give all rewrites to the engine and it loops! *)
    1.99 +            rewrite_goals_tac intensional_rews,
   1.100 +            rewtac lift_abs,
   1.101 +            rewtac pr_lift,
   1.102 +            rewtac unl_lift,
   1.103 +            rtac refl 1
   1.104 +           ]);
   1.105 +
   1.106 +qed_goal "pr_lift2_abs" Action.thy "(%w. f(x w) (y w))` .= f[x`,y`]"
   1.107 +  (fn _ => [rtac actionI 1,
   1.108 +            rewrite_goals_tac intensional_rews,
   1.109 +            rewtac lift2_abs,
   1.110 +            rewtac pr_lift2,
   1.111 +            rewtac unl_lift2,
   1.112 +            rtac refl 1
   1.113 +           ]);
   1.114 +
   1.115 +qed_goal "pr_lift2_abs_con1" Action.thy "(%w. f x (y w))` .= f[#x, y`]"
   1.116 +  (fn _ => [rtac actionI 1,
   1.117 +            rewrite_goals_tac intensional_rews,
   1.118 +            rewtac lift2_abs_con1,
   1.119 +            rewtac pr_lift2,
   1.120 +            rewtac unl_lift2,
   1.121 +            rewtac pr_con,
   1.122 +            rewtac unl_con,
   1.123 +            rtac refl 1
   1.124 +           ]);
   1.125 +
   1.126 +qed_goal "pr_lift2_abs_con2" Action.thy "(%w. f (x w) y)` .= f[x`, #y]"
   1.127 +  (fn _ => [rtac actionI 1,
   1.128 +            rewrite_goals_tac intensional_rews,
   1.129 +            rewtac lift2_abs_con2,
   1.130 +            rewtac pr_lift2,
   1.131 +            rewtac unl_lift2,
   1.132 +            rewtac pr_con,
   1.133 +            rewtac unl_con,
   1.134 +            rtac refl 1
   1.135 +           ]);
   1.136 +
   1.137 +qed_goal "pr_lift3_abs" Action.thy "(%w. f(x w) (y w) (z w))` .= f[x`,y`,z`]"
   1.138 +  (fn _ => [rtac actionI 1,
   1.139 +            rewrite_goals_tac intensional_rews,
   1.140 +            rewtac lift3_abs,
   1.141 +            rewtac pr_lift3,
   1.142 +            rewtac unl_lift3,
   1.143 +            rtac refl 1
   1.144 +           ]);
   1.145 +
   1.146 +qed_goal "pr_lift3_abs_con1" Action.thy "(%w. f x (y w) (z w))` .= f[#x, y`, z`]"
   1.147 +  (fn _ => [rtac actionI 1,
   1.148 +            rewrite_goals_tac intensional_rews,
   1.149 +            rewtac lift3_abs_con1,
   1.150 +            rewtac pr_lift3,
   1.151 +            rewtac unl_lift3,
   1.152 +            rewtac pr_con,
   1.153 +            rewtac unl_con,
   1.154 +            rtac refl 1
   1.155 +           ]);
   1.156 +
   1.157 +qed_goal "pr_lift3_abs_con2" Action.thy "(%w. f (x w) y (z w))` .= f[x`, #y, z`]"
   1.158 +  (fn _ => [rtac actionI 1,
   1.159 +            rewrite_goals_tac intensional_rews,
   1.160 +            rewtac lift3_abs_con2,
   1.161 +            rewtac pr_lift3,
   1.162 +            rewtac unl_lift3,
   1.163 +            rewtac pr_con,
   1.164 +            rewtac unl_con,
   1.165 +            rtac refl 1
   1.166 +           ]);
   1.167 +
   1.168 +qed_goal "pr_lift3_abs_con3" Action.thy "(%w. f (x w) (y w) z)` .= f[x`, y`, #z]"
   1.169 +  (fn _ => [rtac actionI 1,
   1.170 +            rewrite_goals_tac intensional_rews,
   1.171 +            rewtac lift3_abs_con3,
   1.172 +            rewtac pr_lift3,
   1.173 +            rewtac unl_lift3,
   1.174 +            rewtac pr_con,
   1.175 +            rewtac unl_con,
   1.176 +            rtac refl 1
   1.177 +           ]);
   1.178 +
   1.179 +qed_goal "pr_lift3_abs_con12" Action.thy "(%w. f x y (z w))` .= f[#x, #y, z`]"
   1.180 +  (fn _ => [rtac actionI 1,
   1.181 +            rewrite_goals_tac intensional_rews,
   1.182 +            rewtac lift3_abs_con12,
   1.183 +            rewtac pr_lift3,
   1.184 +            rewtac unl_lift3,
   1.185 +            rewtac pr_con,
   1.186 +            rewtac unl_con,
   1.187 +            rtac refl 1
   1.188 +           ]);
   1.189 +
   1.190 +qed_goal "pr_lift3_abs_con13" Action.thy "(%w. f x (y w) z)` .= f[#x, y`, #z]"
   1.191 +  (fn _ => [rtac actionI 1,
   1.192 +            rewrite_goals_tac intensional_rews,
   1.193 +            rewtac lift3_abs_con13,
   1.194 +            rewtac pr_lift3,
   1.195 +            rewtac unl_lift3,
   1.196 +            rewtac pr_con,
   1.197 +            rewtac unl_con,
   1.198 +            rtac refl 1
   1.199 +           ]);
   1.200 +
   1.201 +qed_goal "pr_lift3_abs_con23" Action.thy "(%w. f (x w) y z)` .= f[x`, #y, #z]"
   1.202 +  (fn _ => [rtac actionI 1,
   1.203 +            rewrite_goals_tac intensional_rews,
   1.204 +            rewtac lift3_abs_con23,
   1.205 +            rewtac pr_lift3,
   1.206 +            rewtac unl_lift3,
   1.207 +            rewtac pr_con,
   1.208 +            rewtac unl_con,
   1.209 +            rtac refl 1
   1.210 +           ]);
   1.211 +
   1.212 +(* We don't add these as default rewrite rules, because they are
   1.213 +   rarely needed and may slow down automatic proofs.
   1.214 +*)
   1.215 +val pr_abs_rews = map (fn th => th RS inteq_reflection) 
   1.216 +                      [pr_con_abs,
   1.217 +                       pr_lift_abs,pr_lift2_abs,pr_lift2_abs_con1,pr_lift2_abs_con2,
   1.218 +                       pr_lift3_abs,pr_lift3_abs_con1,pr_lift3_abs_con2,pr_lift3_abs_con3,
   1.219 +                       pr_lift3_abs_con12,pr_lift3_abs_con13,pr_lift3_abs_con23];
   1.220 +
   1.221 +(* =========================== square / angle brackets =========================== *)
   1.222 +
   1.223 +qed_goalw "idle_squareI" Action.thy [square_def]
   1.224 +   "!!s t. ([[s,t]] |= unchanged v) ==> ([[s,t]] |= [A]_v)"
   1.225 +   (fn _ => [ Auto_tac() ]);
   1.226 +
   1.227 +qed_goalw "busy_squareI" Action.thy [square_def]
   1.228 +   "!!s t. ([[s,t]] |= A) ==> ([[s,t]] |= [A]_v)"
   1.229 +   (fn _ => [ Auto_tac() ]);
   1.230 +
   1.231 +qed_goalw "square_simulation" Action.thy [square_def]
   1.232 +   "[| unchanged f .& .~B .-> unchanged g;   \
   1.233 +\      A .& .~unchanged g .-> B              \
   1.234 +\   |] ==> [A]_f .-> [B]_g"
   1.235 +   (fn [p1,p2] => [Auto_tac(),
   1.236 +                   etac (action_conjimpE p2) 1,
   1.237 +                   etac swap 3, etac (action_conjimpE p1) 3,
   1.238 +                   ALLGOALS atac
   1.239 +                  ]);
   1.240 +                   
   1.241 +qed_goalw "not_square" Action.thy [square_def,angle_def]
   1.242 +   "(.~ [A]_v) .= <.~A>_v"
   1.243 +   (fn _ => [ Auto_tac() ]);
   1.244 +
   1.245 +qed_goalw "not_angle" Action.thy [square_def,angle_def]
   1.246 +   "(.~ <A>_v) .= [.~A]_v"
   1.247 +   (fn _ => [ Auto_tac() ]);
   1.248 +
   1.249 +(* ============================== Facts about ENABLED ============================== *)
   1.250 +
   1.251 +qed_goalw "enabledI" Action.thy [enabled_def]
   1.252 +  "A [[s,t]] ==> (Enabled A) s"
   1.253 +  (fn prems => [ REPEAT (resolve_tac (exI::prems) 1) ]);
   1.254 +
   1.255 +qed_goalw "enabledE" Action.thy [enabled_def]
   1.256 +  "[| (Enabled A) s; !!u. A[[s,u]] ==> PROP R |] ==> PROP R"
   1.257 +  (fn prems => [cut_facts_tac prems 1,
   1.258 +                etac exE_prop 1,
   1.259 +                resolve_tac prems 1, atac 1
   1.260 +               ]);
   1.261 +
   1.262 +qed_goal "notEnabledD" Action.thy
   1.263 +  "!!G. ~ (Enabled G s) ==> ~ G [[s,t]]"
   1.264 +  (fn _ => [ auto_tac (action_css addsimps2 [enabled_def]) ]);
   1.265 +
   1.266 +(* Monotonicity *)
   1.267 +qed_goal "enabled_mono" Action.thy
   1.268 +  "[| (Enabled F) s; F .-> G |] ==> (Enabled G) s"
   1.269 +  (fn [min,maj] => [rtac (min RS enabledE) 1,
   1.270 +                    rtac enabledI 1,
   1.271 +                    etac (action_mp maj) 1
   1.272 +                   ]);
   1.273 +
   1.274 +(* stronger variant *)
   1.275 +qed_goal "enabled_mono2" Action.thy
   1.276 +   "[| (Enabled F) s; !!t. (F [[s,t]] ==> G[[s,t]] ) |] ==> (Enabled G) s"
   1.277 +   (fn [min,maj] => [rtac (min RS enabledE) 1,
   1.278 +		     rtac enabledI 1,
   1.279 +		     etac maj 1
   1.280 +		    ]);
   1.281 +
   1.282 +qed_goal "enabled_disj1" Action.thy
   1.283 +  "!!s. (Enabled F) s ==> (Enabled (F .| G)) s"
   1.284 +  (fn _ => [etac enabled_mono 1, Auto_tac()
   1.285 +	   ]);
   1.286 +
   1.287 +qed_goal "enabled_disj2" Action.thy
   1.288 +  "!!s. (Enabled G) s ==> (Enabled (F .| G)) s"
   1.289 +  (fn _ => [etac enabled_mono 1, Auto_tac()
   1.290 +	   ]);
   1.291 +
   1.292 +qed_goal "enabled_conj1" Action.thy
   1.293 +  "!!s. (Enabled (F .& G)) s ==> (Enabled F) s"
   1.294 +  (fn _ => [etac enabled_mono 1, Auto_tac()
   1.295 +           ]);
   1.296 +
   1.297 +qed_goal "enabled_conj2" Action.thy
   1.298 +  "!!s. (Enabled (F .& G)) s ==> (Enabled G) s"
   1.299 +  (fn _ => [etac enabled_mono 1, Auto_tac()
   1.300 +           ]);
   1.301 +
   1.302 +qed_goal "enabled_conjE" Action.thy
   1.303 +  "[| (Enabled (F .& G)) s; [| (Enabled F) s; (Enabled G) s |] ==> PROP R |] ==> PROP R"
   1.304 +  (fn prems => [cut_facts_tac prems 1, resolve_tac prems 1,
   1.305 +                etac enabled_conj1 1, etac enabled_conj2 1]);
   1.306 +
   1.307 +qed_goal "enabled_disjD" Action.thy
   1.308 +  "!!s. (Enabled (F .| G)) s ==> ((Enabled F) s) | ((Enabled G) s)"
   1.309 +  (fn _ => [etac enabledE 1,
   1.310 +            auto_tac (action_css addSDs2 [notEnabledD] addSEs2 [enabledI])
   1.311 +           ]);
   1.312 +
   1.313 +qed_goal "enabled_disj" Action.thy
   1.314 +  "(Enabled (F .| G)) s = ( (Enabled F) s | (Enabled G) s )"
   1.315 +  (fn _ => [rtac iffI 1,
   1.316 +            etac enabled_disjD 1,
   1.317 +            REPEAT (eresolve_tac [disjE,enabled_disj1,enabled_disj2] 1)
   1.318 +           ]);
   1.319 +
   1.320 +qed_goal "enabled_ex" Action.thy
   1.321 +  "(Enabled (REX x. F x)) s = (EX x. (Enabled (F x)) s)"
   1.322 +  (fn _ => [ auto_tac (action_css addsimps2 [enabled_def]) ]);
   1.323 +	    
   1.324 +
   1.325 +(* A rule that combines enabledI and baseE, but generates fewer possible instantiations *)
   1.326 +qed_goal "base_enabled" Action.thy
   1.327 +  "[| base_var(v); !!u. v u = c s ==> A [[s,u]] |] ==> Enabled A s"
   1.328 +  (fn prems => [cut_facts_tac prems 1,
   1.329 +		etac baseE 1, rtac enabledI 1,
   1.330 +		REPEAT (ares_tac prems 1)]);
   1.331 +
   1.332 +
   1.333 +(* ---------------- enabled_tac: tactic to prove (Enabled A) -------------------- *)
   1.334 +(* "Enabled A" can be proven as follows:
   1.335 +   - Assume that we know which state variables are "base variables";
   1.336 +     this should be expressed by a theorem of the form "base_var <x,y,z,...>".
   1.337 +   - Resolve this theorem with baseE to introduce a constant for the value of the
   1.338 +     variables in the successor state, and resolve the goal with the result.
   1.339 +   - E-resolve with PairVarE so that we have one constant per variable.
   1.340 +   - Resolve with enabledI and do some rewriting.
   1.341 +   - Solve for the unknowns using standard HOL reasoning.
   1.342 +   The following tactic combines these steps except the final one.
   1.343 +*)
   1.344 +
   1.345 +fun enabled_tac base_vars i =
   1.346 +    EVERY [(* apply actionI (plus rewriting) if the goal is of the form $(Enabled A),
   1.347 +	      do nothing if it is of the form (Enabled A) s *)
   1.348 +	   TRY ((rtac actionI i) THEN (SELECT_GOAL (rewrite_goals_tac action_rews) i)),
   1.349 +	   rtac (base_vars RS base_enabled) i,
   1.350 +	   REPEAT_DETERM (etac PairVarE i),
   1.351 +	   (SELECT_GOAL (rewrite_goals_tac action_rews) i)
   1.352 +	  ];
   1.353 +
   1.354 +(* Example of use:
   1.355 +
   1.356 +val [prem] = goal Action.thy "base_var <x,y,z> ==> $x .-> $Enabled ($x .& (y$ .= #False))";
   1.357 +by (REPEAT ((CHANGED (Action_simp_tac 1)) ORELSE (enabled_tac prem 1)));
   1.358 +
   1.359 +*)
     2.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.2 +++ b/src/HOL/TLA/Action.thy	Wed Oct 08 11:50:33 1997 +0200
     2.3 @@ -0,0 +1,60 @@
     2.4 +(* 
     2.5 +    File:	 TLA/Action.thy
     2.6 +    Author:      Stephan Merz
     2.7 +    Copyright:   1997 University of Munich
     2.8 +
     2.9 +    Theory Name: Action
    2.10 +    Logic Image: HOL
    2.11 +
    2.12 +Define the action level of TLA as an Isabelle theory.
    2.13 +*)
    2.14 +
    2.15 +Action  =  Intensional + Stfun +
    2.16 +
    2.17 +types
    2.18 +    state2      (* intention: pair of states *)
    2.19 +    'a trfct = "('a, state2) term"
    2.20 +    action   = "state2 form"
    2.21 +
    2.22 +arities
    2.23 +    state2 :: world
    2.24 +    
    2.25 +consts
    2.26 +  mkstate2      :: "[state,state] => state2"  ("([[_,_]])")
    2.27 +
    2.28 +  (* lift state variables to transition functions *)
    2.29 +  before        :: "'a stfun => 'a trfct"            ("($_)"  [100] 99)
    2.30 +  after         :: "'a stfun => 'a trfct"            ("(_$)"  [100] 99)
    2.31 +  unchanged     :: "'a stfun => action"
    2.32 +
    2.33 +  (* Priming *)
    2.34 +  prime         :: "'a trfct => 'a trfct"            ("(_`)" [90] 89)
    2.35 +
    2.36 +  SqAct         :: "[action, 'a stfun] => action"    ("([_]'_(_))" [0,60] 59)
    2.37 +  AnAct         :: "[action, 'a stfun] => action"    ("(<_>'_(_))" [0,60] 59)
    2.38 +  Enabled       :: "action => stpred"
    2.39 +
    2.40 +rules
    2.41 +  (* The following says that state2 is generated by mkstate2 *)
    2.42 +  state2_ext    "(!!s t. [[s,t]] |= (A::action)) ==> (st::state2) |= A"
    2.43 +
    2.44 +  unl_before    "($v) [[s,t]] == v s"
    2.45 +  unl_after     "(v$) [[s,t]] == v t"
    2.46 +
    2.47 +  pr_con        "(#c)` == #c"
    2.48 +  pr_before     "($v)` == v$"
    2.49 +  (* no corresponding rule for "after"! *)
    2.50 +  pr_lift       "(F[x])` == F[x`]"
    2.51 +  pr_lift2      "(F[x,y])` == F[x`,y`]"
    2.52 +  pr_lift3      "(F[x,y,z])` == F[x`,y`,z`]"
    2.53 +  pr_all        "(RALL x. P(x))` == (RALL x. P(x)`)"
    2.54 +  pr_ex         "(REX x. P(x))` == (REX x. P(x)`)"
    2.55 +
    2.56 +  unchanged_def "(unchanged v) [[s,t]] == (v t = v s)"
    2.57 +  square_def    "[A]_v == A .| unchanged v"
    2.58 +  angle_def     "<A>_v == A .& .~ unchanged v"
    2.59 +
    2.60 +  enabled_def   "(Enabled A) s  ==  EX u. A[[s,u]]"
    2.61 +end
    2.62 +
    2.63 +
     3.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.2 +++ b/src/HOL/TLA/Buffer/Buffer.ML	Wed Oct 08 11:50:33 1997 +0200
     3.3 @@ -0,0 +1,48 @@
     3.4 +(* 
     3.5 +    File:        Buffer.ML
     3.6 +    Author:      Stephan Merz
     3.7 +    Copyright:   1997 University of Munich
     3.8 +
     3.9 +    Simple FIFO buffer (theorems and proofs)
    3.10 +*)
    3.11 +
    3.12 +(* ---------------------------- Data lemmas ---------------------------- *)
    3.13 +
    3.14 +goal List.thy "xs ~= [] --> tl(xs @ ys) = (tl xs) @ ys";
    3.15 +by (auto_tac (!claset, !simpset addsimps [tl_append,neq_Nil_conv]));
    3.16 +qed_spec_mp "tl_append2";
    3.17 +Addsimps [tl_append2];
    3.18 +
    3.19 +goal List.thy "xs ~= [] --> tl xs ~= xs";
    3.20 +by (auto_tac (!claset, !simpset addsimps [neq_Nil_conv]));
    3.21 +qed_spec_mp "tl_not_self";
    3.22 +Addsimps [tl_not_self];
    3.23 +
    3.24 +goal List.thy "!ys zs. (ys @ xs = zs @ xs) = (ys=zs)";
    3.25 +by (induct_tac "xs" 1);
    3.26 +by (Simp_tac 1);
    3.27 +by (REPEAT (rtac allI 1));
    3.28 +by (subgoal_tac "((ys @ [a]) @ list = (zs @ [a]) @ list) = (ys=zs)" 1);
    3.29 +by (Asm_full_simp_tac 1);
    3.30 +by (Blast_tac 1);
    3.31 +qed_spec_mp "append_same_eq";
    3.32 +AddIffs [append_same_eq];
    3.33 +
    3.34 +(* ---------------------------- Action lemmas ---------------------------- *)
    3.35 +
    3.36 +(* Dequeue is visible *)
    3.37 +goal Buffer.thy "<Deq ic q oc>_<ic,q,oc> .= Deq ic q oc";
    3.38 +by (auto_tac (!claset, !simpset addsimps [angle_def,Deq_def]));
    3.39 +qed "Deq_visible";
    3.40 +
    3.41 +(* Enabling condition for dequeue -- NOT NEEDED *)
    3.42 +goalw Buffer.thy [temp_rewrite Deq_visible]
    3.43 +   "!!q. base_var <ic,q,oc> ==> $Enabled (<Deq ic q oc>_<ic,q,oc>) .= ($q .~= .[])";
    3.44 +by (auto_tac (!claset addSEs [base_enabled,enabledE], !simpset addsimps [Deq_def]));
    3.45 +qed "Deq_enabled";
    3.46 +
    3.47 +(* For the left-to-right implication, we don't need the base variable stuff *)
    3.48 +goalw Buffer.thy [temp_rewrite Deq_visible] 
    3.49 +   "$Enabled (<Deq ic q oc>_<ic,q,oc>) .-> ($q .~= .[])";
    3.50 +by (auto_tac (!claset addSEs [enabledE], !simpset addsimps [Deq_def]));
    3.51 +qed "Deq_enabledE";
     4.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.2 +++ b/src/HOL/TLA/Buffer/Buffer.thy	Wed Oct 08 11:50:33 1997 +0200
     4.3 @@ -0,0 +1,57 @@
     4.4 +(*
     4.5 +    File:        Buffer.thy
     4.6 +    Author:      Stephan Merz
     4.7 +    Copyright:   1997 University of Munich
     4.8 +
     4.9 +   Theory Name: Buffer
    4.10 +   Logic Image: TLA
    4.11 +
    4.12 +   A simple FIFO buffer (synchronous communication, interleaving)
    4.13 +*)
    4.14 +
    4.15 +Buffer = TLA + List +
    4.16 +
    4.17 +consts
    4.18 +  (* infix syntax for list operations *)
    4.19 +  "IntNil"  :: 'w::world => 'a list                                       (".[]")
    4.20 +  "IntCons" :: ['w::world => 'a, 'w => 'a list] => ('w => 'a list)        ("(_ .#/ _)" [65,66] 65)
    4.21 +  "IntApp"  :: ['w::world => 'a list, 'w => 'a list] => ('w => 'a list)   ("(_ .@/ _)" [65,66] 65)
    4.22 +
    4.23 +  (* actions *)
    4.24 +  BInit     :: "'a stfun => 'a list stfun => 'a stfun => action"
    4.25 +  Enq       :: "'a stfun => 'a list stfun => 'a stfun => action"
    4.26 +  Deq       :: "'a stfun => 'a list stfun => 'a stfun => action"
    4.27 +  Next      :: "'a stfun => 'a list stfun => 'a stfun => action"
    4.28 +
    4.29 +  (* temporal formulas *)
    4.30 +  IBuffer   :: "'a stfun => 'a list stfun => 'a stfun => temporal"
    4.31 +  Buffer    :: "'a stfun => 'a stfun => temporal"
    4.32 +
    4.33 +syntax
    4.34 +  "@listInt" :: args => ('a list, 'w) term      (".[(_)]")
    4.35 +
    4.36 +translations
    4.37 +  ".[]"          == "con []"
    4.38 +  "x .# xs"      == "lift2 (op #) x xs"
    4.39 +  "xs .@ ys"     == "lift2 (op @) xs ys"
    4.40 +  ".[ x, xs ]"   == "x .# .[xs]"
    4.41 +  ".[ x ]"       == "x .# .[]"
    4.42 +
    4.43 +rules
    4.44 +  BInit_def   "BInit ic q oc    == $q .= .[]"
    4.45 +  Enq_def     "Enq ic q oc      ==    (ic$ .~= $ic) 
    4.46 +                                   .& (q$ .= $q .@ .[ ic$ ]) 
    4.47 +                                   .& (oc$ .= $oc)"
    4.48 +  Deq_def     "Deq ic q oc      ==    ($q .~= .[])
    4.49 +                                   .& (oc$ .= hd[ $q ])
    4.50 +                                   .& (q$ .= tl[ $q ])
    4.51 +                                   .& (ic$ .= $ic)"
    4.52 +  Next_def    "Next ic q oc     == Enq ic q oc .| Deq ic q oc"
    4.53 +  IBuffer_def "IBuffer ic q oc  ==    Init (BInit ic q oc)
    4.54 +                                   .& [][Next ic q oc]_<ic,q,oc>
    4.55 +                                   .& WF(Deq ic q oc)_<ic,q,oc>"
    4.56 +  Buffer_def  "Buffer ic oc     == EEX q. IBuffer ic q oc"
    4.57 +end
    4.58 +
    4.59 +
    4.60 +
     5.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.2 +++ b/src/HOL/TLA/Buffer/DBuffer.ML	Wed Oct 08 11:50:33 1997 +0200
     5.3 @@ -0,0 +1,119 @@
     5.4 +(* 
     5.5 +    File:        DBuffer.ML
     5.6 +    Author:      Stephan Merz
     5.7 +    Copyright:   1997 University of Munich
     5.8 +
     5.9 +    Double FIFO buffer implements simple FIFO buffer.
    5.10 +*)
    5.11 +
    5.12 +val db_css = (!claset, !simpset addsimps [qc_def]);
    5.13 +Addsimps [qc_def];
    5.14 +
    5.15 +val db_defs = [BInit_def, Enq_def, Deq_def, Next_def, IBuffer_def, Buffer_def,
    5.16 +               DBInit_def,DBEnq_def,DBDeq_def,DBPass_def,DBNext_def,DBuffer_def];
    5.17 +
    5.18 +
    5.19 +(*** Proper initialization ***)
    5.20 +goal DBuffer.thy "Init DBInit .-> Init (BInit inp qc out)";
    5.21 +by (auto_tac (db_css addsimps2 [Init_def,DBInit_def,BInit_def]));
    5.22 +qed "DBInit";
    5.23 +
    5.24 +
    5.25 +(*** Step simulation ***)
    5.26 +goal DBuffer.thy "[DBNext]_<inp,mid,out,q1,q2> .-> [Next inp qc out]_<inp,qc,out>";
    5.27 +by (rtac square_simulation 1);
    5.28 +by (Action_simp_tac 1);
    5.29 +by (action_simp_tac (!simpset addsimps hd_append::db_defs) [] [] 1);
    5.30 +qed "DB_step_simulation";
    5.31 +
    5.32 +
    5.33 +(*** Simulation of fairness ***)
    5.34 +
    5.35 +(* Compute enabledness predicates for DBDeq and DBPass actions *)
    5.36 +goal DBuffer.thy "<DBDeq>_<inp,mid,out,q1,q2> .= DBDeq";
    5.37 +by (auto_tac (db_css addsimps2 [angle_def,DBDeq_def,Deq_def]));
    5.38 +qed "DBDeq_visible";
    5.39 +
    5.40 +goal DBuffer.thy "$Enabled (<DBDeq>_<inp,mid,out,q1,q2>) .= ($q2 .~= .[])";
    5.41 +by (rewtac (action_rewrite DBDeq_visible));
    5.42 +by (cut_facts_tac [DB_base] 1);
    5.43 +by (auto_tac (db_css addSEs2 [base_enabled,enabledE] 
    5.44 +                     addsimps2 [angle_def,DBDeq_def,Deq_def]));
    5.45 +qed "DBDeq_enabled";
    5.46 +
    5.47 +goal DBuffer.thy "<DBPass>_<inp,mid,out,q1,q2> .= DBPass";
    5.48 +by (auto_tac (db_css addsimps2 [angle_def,DBPass_def,Deq_def]));
    5.49 +qed "DBPass_visible";
    5.50 +
    5.51 +goal DBuffer.thy "$Enabled (<DBPass>_<inp,mid,out,q1,q2>) .= ($q1 .~= .[])";
    5.52 +by (rewtac (action_rewrite DBPass_visible));
    5.53 +by (cut_facts_tac [DB_base] 1);
    5.54 +by (auto_tac (db_css addSEs2 [base_enabled,enabledE] 
    5.55 +                     addsimps2 [angle_def,DBPass_def,Deq_def]));
    5.56 +qed "DBPass_enabled";
    5.57 +
    5.58 +
    5.59 +(* The plan for proving weak fairness at the higher level is to prove
    5.60 +   (0)  DBuffer => (Enabled (Deq inp qc out) ~> (Deq inp qc out))
    5.61 +   which is in turn reduced to the two leadsto conditions
    5.62 +   (1)  DBuffer => (Enabled (Deq inp qc out) ~> q2 ~= [])
    5.63 +   (2)  DBuffer => (q2 ~= [] ~> DBDeq)
    5.64 +   and the fact that DBDeq implies <Deq inp qc out>_<inp,qc,out>
    5.65 +   (and therefore DBDeq ~> <Deq inp qc out>_<inp,qc,out> trivially holds).
    5.66 +
    5.67 +   Condition (1) is reduced to
    5.68 +   (1a) DBuffer => (qc ~= [] /\ q2 = [] ~> q2 ~= [])
    5.69 +   by standard leadsto rules (leadsto_classical) and rule Deq_enabledE.
    5.70 +
    5.71 +   Both (1a) and (2) are proved from DBuffer's WF conditions by standard
    5.72 +   WF reasoning (Lamport's WF1 and WF_leadsto).
    5.73 +   The condition WF(Deq inp qc out) follows from (0) by rule leadsto_WF.
    5.74 +
    5.75 +   One could use Lamport's WF2 instead.
    5.76 +*)
    5.77 +
    5.78 +(* Condition (1a) *)
    5.79 +goal DBuffer.thy 
    5.80 +  "[][DBNext]_<inp,mid,out,q1,q2> .& WF(DBPass)_<inp,mid,out,q1,q2> \
    5.81 +\  .-> ($qc .~= .[] .& $q2 .= .[] ~> $q2 .~= .[])";
    5.82 +by (rtac WF1 1);
    5.83 +by (action_simp_tac (!simpset addsimps square_def::db_defs) [] [] 1);
    5.84 +by (action_simp_tac (!simpset addsimps [angle_def,DBPass_def]) [] [] 1);
    5.85 +by (action_simp_tac (!simpset addsimps [DBPass_enabled]) [] [] 1);
    5.86 +qed "DBFair_1a";
    5.87 +
    5.88 +(* Condition (1) *)
    5.89 +goal DBuffer.thy
    5.90 +  "[][DBNext]_<inp,mid,out,q1,q2> .& WF(DBPass)_<inp,mid,out,q1,q2> \
    5.91 +\  .-> ($Enabled (<Deq inp qc out>_<inp,qc,out>) ~> $q2 .~= .[])";
    5.92 +by (auto_tac (temp_css addSIs2 [leadsto_classical] addSEs2 [temp_conjimpE DBFair_1a]));
    5.93 +by (auto_tac (temp_css addsimps2 [leadsto,Init_def] addDs2 [STL2bD]
    5.94 +                       addSDs2 [action_mp Deq_enabledE] addSEs2 [STL4E]));
    5.95 +qed "DBFair_1";
    5.96 +
    5.97 +(* Condition (2) *)
    5.98 +goal DBuffer.thy
    5.99 +  "[][DBNext]_<inp,mid,out,q1,q2> .& WF(DBDeq)_<inp,mid,out,q1,q2> \
   5.100 +\  .-> ($q2 .~= .[] ~> DBDeq)";
   5.101 +by (rtac WF_leadsto 1);
   5.102 +by (action_simp_tac (!simpset addsimps [DBDeq_visible,DBDeq_enabled]) [] [] 1);
   5.103 +by (action_simp_tac (!simpset addsimps [angle_def]) [] [] 1);
   5.104 +by (action_simp_tac (!simpset addsimps square_def::db_defs) [tempI] [Stable] 1);
   5.105 +qed "DBFair_2";
   5.106 +
   5.107 +(* High-level fairness *)
   5.108 +goal DBuffer.thy
   5.109 +  "[][DBNext]_<inp,mid,out,q1,q2> .& WF(DBPass)_<inp,mid,out,q1,q2> \
   5.110 +\                                 .& WF(DBDeq)_<inp,mid,out,q1,q2>  \ 
   5.111 +\  .-> WF(Deq inp qc out)_<inp,qc,out>";
   5.112 +by (auto_tac (db_css addSIs2 [leadsto_WF]));
   5.113 +by (auto_tac (db_css addSIs2 [(temp_mp DBFair_1) RSN(2,LatticeTransitivity)]));
   5.114 +by (auto_tac (db_css addSIs2 [(temp_mp DBFair_2) RSN(2,LatticeTransitivity)]));
   5.115 +by (auto_tac (db_css addSIs2 [ImplLeadsto] addSEs2 [STL4E]
   5.116 +                     addsimps2 [angle_def,DBDeq_def,Deq_def,hd_append]));
   5.117 +qed "DBFair";
   5.118 +
   5.119 +(*** Main theorem ***)
   5.120 +goalw DBuffer.thy [DBuffer_def,Buffer_def,IBuffer_def] "DBuffer .-> Buffer inp out";
   5.121 +by (auto_tac (db_css addSIs2 (map temp_mp [eexI,DBInit,DB_step_simulation RS STL4,DBFair])));
   5.122 +qed "DBuffer_impl_Buffer";
     6.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.2 +++ b/src/HOL/TLA/Buffer/DBuffer.thy	Wed Oct 08 11:50:33 1997 +0200
     6.3 @@ -0,0 +1,40 @@
     6.4 +(*
     6.5 +    File:        DBuffer.thy
     6.6 +    Author:      Stephan Merz
     6.7 +    Copyright:   1997 University of Munich
     6.8 +
     6.9 +   Theory Name: DBuffer
    6.10 +   Logic Image: TLA
    6.11 +
    6.12 +   Two FIFO buffers in a row, with interleaving assumption.
    6.13 +*)
    6.14 +
    6.15 +DBuffer = Buffer +
    6.16 +
    6.17 +consts
    6.18 +  (* implementation variables *)
    6.19 +  inp, mid, out  :: nat stfun
    6.20 +  q1, q2, qc     :: nat list stfun
    6.21 +
    6.22 +  DBInit, DBEnq, DBDeq, DBPass, DBNext   :: action
    6.23 +  DBuffer                                :: temporal
    6.24 +
    6.25 +rules
    6.26 +  DB_base        "base_var <inp,mid,out,q1,q2>"
    6.27 +
    6.28 +  (* the concatenation of the two buffers *)
    6.29 +  qc_def         "$qc .= $q2 .@ $q1"
    6.30 +
    6.31 +  DBInit_def     "DBInit   == BInit inp q1 mid  .&  BInit mid q2 out"
    6.32 +  DBEnq_def      "DBEnq    == Enq inp q1 mid  .&  unchanged <q2,out>"
    6.33 +  DBDeq_def      "DBDeq    == Deq mid q2 out .&  unchanged <inp,q1>"
    6.34 +  DBPass_def     "DBPass   ==    Deq inp q1 mid
    6.35 +                              .& (q2$ .= $q2 .@ .[ mid$ ])
    6.36 +                              .& (out$ .= $out)"
    6.37 +  DBNext_def     "DBNext   == DBEnq .| DBDeq .| DBPass"
    6.38 +  DBuffer_def    "DBuffer  ==    Init(DBInit)
    6.39 +                              .& [][DBNext]_<inp,mid,out,q1,q2>
    6.40 +                              .& WF(DBDeq)_<inp,mid,out,q1,q2>
    6.41 +                              .& WF(DBPass)_<inp,mid,out,q1,q2>"
    6.42 +
    6.43 +end
    6.44 \ No newline at end of file
     7.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.2 +++ b/src/HOL/TLA/Inc/Inc.ML	Wed Oct 08 11:50:33 1997 +0200
     7.3 @@ -0,0 +1,253 @@
     7.4 +(* 
     7.5 +    File:	 TLA/ex/inc/Inc.ML
     7.6 +    Author:      Stephan Merz
     7.7 +    Copyright:   1997 University of Munich
     7.8 +
     7.9 +Proofs for the "increment" example from SRC79.
    7.10 +*)
    7.11 +
    7.12 +val PsiInv_defs = [PsiInv_def,PsiInv1_def,PsiInv2_def,PsiInv3_def];
    7.13 +val Psi_defs = [Psi_def,InitPsi_def,N1_def,N2_def,alpha1_def,alpha2_def,
    7.14 +                beta1_def,beta2_def,gamma1_def,gamma2_def];
    7.15 +
    7.16 +val Inc_css = (!claset, !simpset);
    7.17 +
    7.18 +(*** Invariant proof for Psi: "manual" proof proves individual lemmas ***)
    7.19 +
    7.20 +qed_goal "PsiInv_Init" Inc.thy "InitPsi .-> PsiInv"
    7.21 + (fn _ => [ auto_tac (Inc_css addsimps2 InitPsi_def::PsiInv_defs) ]);
    7.22 +
    7.23 +qed_goal "PsiInv_alpha1" Inc.thy "alpha1 .& PsiInv .-> PsiInv`"
    7.24 +  (fn _ => [ auto_tac (Inc_css addsimps2 alpha1_def::PsiInv_defs) ]);
    7.25 +
    7.26 +qed_goal "PsiInv_alpha2" Inc.thy "alpha2 .& PsiInv .-> PsiInv`"
    7.27 +  (fn _ => [ auto_tac (Inc_css addsimps2 alpha2_def::PsiInv_defs) ]);
    7.28 +
    7.29 +qed_goal "PsiInv_beta1" Inc.thy "beta1 .& PsiInv .-> PsiInv`"
    7.30 +  (fn _ => [ auto_tac (Inc_css addsimps2 beta1_def::PsiInv_defs) ]);
    7.31 +
    7.32 +qed_goal "PsiInv_beta2" Inc.thy "beta2 .& PsiInv .-> PsiInv`"
    7.33 +  (fn _ => [ auto_tac (Inc_css addsimps2 beta2_def::PsiInv_defs) ]);
    7.34 +
    7.35 +qed_goal "PsiInv_gamma1" Inc.thy "gamma1 .& PsiInv .-> PsiInv`"
    7.36 +  (fn _ => [ auto_tac (Inc_css addsimps2 gamma1_def::PsiInv_defs) ]);
    7.37 +
    7.38 +qed_goal "PsiInv_gamma2" Inc.thy "gamma2 .& PsiInv .-> PsiInv`"
    7.39 +  (fn _ => [ auto_tac (Inc_css addsimps2 gamma2_def::PsiInv_defs) ]);
    7.40 +
    7.41 +qed_goal "PsiInv_stutter" Inc.thy "unchanged <x,y,sem,pc1,pc2> .& PsiInv .-> PsiInv`"
    7.42 +  (fn _ => [ auto_tac (Inc_css addsimps2 PsiInv_defs) ]);
    7.43 +
    7.44 +qed_goal "PsiInv" Inc.thy "Psi .-> []PsiInv"
    7.45 +  (fn _ => [inv_tac (Inc_css addsimps2 [Psi_def]) 1,
    7.46 +	    SELECT_GOAL (auto_tac (Inc_css addSIs2 [action_mp PsiInv_Init]
    7.47 +				           addsimps2 [Init_def])) 1,
    7.48 +	    auto_tac (Inc_css addSEs2 (map action_conjimpE
    7.49 +				           [PsiInv_alpha1,PsiInv_alpha2,PsiInv_beta1,
    7.50 +					    PsiInv_beta2,PsiInv_gamma1,PsiInv_gamma2])
    7.51 +		              addIs2 [action_mp PsiInv_stutter]
    7.52 +                              addsimps2 [square_def,N1_def, N2_def])
    7.53 +	   ]);
    7.54 +
    7.55 +
    7.56 +
    7.57 +(* Automatic proof works too, but it make take a while on a slow machine.
    7.58 +   More substantial examples require manual guidance anyway.
    7.59 +
    7.60 +goal Inc.thy "Psi .-> []PsiInv";
    7.61 +by (auto_inv_tac (!simpset addsimps PsiInv_defs @ Psi_defs @ pcount.simps) 1);
    7.62 +
    7.63 +*)
    7.64 +
    7.65 +(**** Step simulation ****)
    7.66 +
    7.67 +qed_goal "Init_sim" Inc.thy "Psi .-> Init(InitPhi)"
    7.68 +  (fn _ => [ auto_tac (Inc_css addsimps2 [InitPhi_def,Psi_def,InitPsi_def,Init_def]) ]);
    7.69 +
    7.70 +qed_goal "Step_sim" Inc.thy "Psi .-> [][M1 .| M2]_<x,y>"
    7.71 +  (fn _ => [auto_tac (Inc_css addsimps2 [square_def,M1_def,M2_def] @ Psi_defs
    7.72 +                              addSEs2 [STL4E]) 
    7.73 +           ]);
    7.74 +
    7.75 +(**** Proof of fairness ****)
    7.76 +
    7.77 +(*
    7.78 +   The goal is to prove Fair_M1 far below, which asserts 
    7.79 +         Psi .-> WF(M1)_<x,y>   
    7.80 +   (the other fairness condition is symmetrical).
    7.81 +
    7.82 +   The strategy is to use WF2 (with beta1 as the helpful action). Proving its
    7.83 +   temporal premise needs two auxiliary lemmas:
    7.84 +   1. Stuck_at_b: control can only proceed at pc1 = b by executing beta1
    7.85 +   2. N1_live: the first component will eventually reach b
    7.86 +
    7.87 +   Lemma 1 is easy, lemma 2 relies on the invariant, the strong fairness
    7.88 +   of the semaphore, and needs auxiliary lemmas that ensure that the second
    7.89 +   component will eventually release the semaphore. Most of the proofs of
    7.90 +   the auxiliary lemmas are very similar.
    7.91 +*)
    7.92 +
    7.93 +qed_goal "Stuck_at_b" Inc.thy
    7.94 +  "[][(N1 .| N2) .& .~ beta1]_<x,y,sem,pc1,pc2> .-> stable($pc1 .= #b)"
    7.95 +  (fn _ => [rtac StableL 1,
    7.96 +	    auto_tac (Inc_css addsimps2 square_def::Psi_defs)
    7.97 +	   ]);
    7.98 +
    7.99 +qed_goal "N1_enabled_at_g" Inc.thy
   7.100 +  "($pc1 .= #g) .-> $(Enabled (<N1>_<x,y,sem,pc1,pc2>))"
   7.101 +  (fn _ => [Action_simp_tac 1,
   7.102 +	    res_inst_tac [("F","gamma1")] enabled_mono 1,
   7.103 +	    enabled_tac Inc_base 1,
   7.104 +	    auto_tac (Inc_css addsimps2 [angle_def,gamma1_def,N1_def])
   7.105 +	   ]);
   7.106 +
   7.107 +qed_goal "g1_leadsto_a1" Inc.thy
   7.108 +  "[][(N1 .| N2) .& .~ beta1]_<x,y,sem,pc1,pc2> .& SF(N1)_<x,y,sem,pc1,pc2> .& []#True \
   7.109 +\  .-> ($pc1 .= #g ~> $pc1 .= #a)"
   7.110 +  (fn _ => [rtac SF1 1,
   7.111 +	    (* the first two subgoals are simple action formulas and succumb to the
   7.112 +	       auto_tac; don't expand N1 in the third subgoal *)
   7.113 +	    SELECT_GOAL (auto_tac (Inc_css addsimps2 [square_def] @ Psi_defs)) 1,
   7.114 +	    SELECT_GOAL (auto_tac (Inc_css addsimps2 [angle_def] @ Psi_defs)) 1,
   7.115 +	    (* reduce []A .-> <>Enabled B  to  A .-> Enabled B *)
   7.116 +	    auto_tac (Inc_css addSIs2 [InitDmdD, action_mp N1_enabled_at_g]
   7.117 +		              addSDs2 [STL2bD]
   7.118 +		              addsimps2 [Init_def])
   7.119 +	   ]);
   7.120 +
   7.121 +(* symmetrical for N2, and similar for beta2 *)
   7.122 +qed_goal "N2_enabled_at_g" Inc.thy
   7.123 +  "($pc2 .= #g) .-> $(Enabled (<N2>_<x,y,sem,pc1,pc2>))"
   7.124 +  (fn _ => [Action_simp_tac 1,
   7.125 +	    res_inst_tac [("F","gamma2")] enabled_mono 1,
   7.126 +	    enabled_tac Inc_base 1,
   7.127 +	    auto_tac (Inc_css addsimps2 [angle_def,gamma2_def,N2_def])
   7.128 +	   ]);
   7.129 +
   7.130 +qed_goal "g2_leadsto_a2" Inc.thy
   7.131 +  "[][(N1 .| N2) .& .~ beta1]_<x,y,sem,pc1,pc2> .& SF(N2)_<x,y,sem,pc1,pc2> .& []#True \
   7.132 +\  .-> ($pc2 .= #g ~> $pc2 .= #a)"
   7.133 +  (fn _ => [rtac SF1 1,
   7.134 +	    SELECT_GOAL (auto_tac (Inc_css addsimps2 [square_def] @ Psi_defs)) 1,
   7.135 +	    SELECT_GOAL (auto_tac (Inc_css addsimps2 [angle_def] @ Psi_defs)) 1,
   7.136 +	    auto_tac (Inc_css addSIs2 [InitDmdD, action_mp N2_enabled_at_g]
   7.137 +		              addSDs2 [STL2bD]
   7.138 +		              addsimps2 [Init_def])
   7.139 +	   ]);
   7.140 +
   7.141 +qed_goal "N2_enabled_at_b" Inc.thy
   7.142 +  "($pc2 .= #b) .-> $(Enabled (<N2>_<x,y,sem,pc1,pc2>))"
   7.143 +  (fn _ => [Action_simp_tac 1,
   7.144 +	    res_inst_tac [("F","beta2")] enabled_mono 1,
   7.145 +	    enabled_tac Inc_base 1,
   7.146 +	    auto_tac (Inc_css addsimps2 [angle_def,beta2_def,N2_def])
   7.147 +	   ]);
   7.148 +
   7.149 +qed_goal "b2_leadsto_g2" Inc.thy
   7.150 +  "[][(N1 .| N2) .& .~ beta1]_<x,y,sem,pc1,pc2> .& SF(N2)_<x,y,sem,pc1,pc2> .& []#True \
   7.151 +\  .-> ($pc2 .= #b ~> $pc2 .= #g)"
   7.152 +  (fn _ => [rtac SF1 1,
   7.153 +	    SELECT_GOAL (auto_tac (Inc_css addsimps2 [square_def] @ Psi_defs)) 1,
   7.154 +	    SELECT_GOAL (auto_tac (Inc_css addsimps2 [angle_def] @ Psi_defs)) 1,
   7.155 +	    auto_tac (Inc_css addSIs2 [InitDmdD, action_mp N2_enabled_at_b]
   7.156 +		              addSDs2 [STL2bD]
   7.157 +		              addsimps2 [Init_def])
   7.158 +	   ]);
   7.159 +
   7.160 +(* Combine above lemmas: the second component will eventually reach pc2 = a *)
   7.161 +qed_goal "N2_leadsto_a" Inc.thy
   7.162 +  "[][(N1 .| N2) .& .~ beta1]_<x,y,sem,pc1,pc2> .& SF(N2)_<x,y,sem,pc1,pc2> .& []#True \
   7.163 +\  .-> (($pc2 .= #a .| $pc2 .= #b .| $pc2 .= #g) ~> $pc2 .= #a)"
   7.164 +  (fn _ => [auto_tac (Inc_css addSIs2 [LatticeDisjunctionIntro]),
   7.165 +	    rtac (LatticeReflexivity RS tempD) 1,
   7.166 +	    rtac LatticeTransitivity 1,
   7.167 +	    auto_tac (Inc_css addSIs2 (map temp_mp [b2_leadsto_g2,g2_leadsto_a2]))
   7.168 +	   ]);
   7.169 +
   7.170 +(* A variant that gets rid of the disjunction, thanks to induction over data types *)
   7.171 +qed_goal "N2_live" Inc.thy
   7.172 +  "[][(N1 .| N2) .& .~ beta1]_<x,y,sem,pc1,pc2> .& SF(N2)_<x,y,sem,pc1,pc2> \
   7.173 +\  .-> <>($pc2 .= #a)"
   7.174 +  (fn _ => [auto_tac (Inc_css addSIs2 [(temp_mp N2_leadsto_a) RSN(2,leadsto_init)]),
   7.175 +	    rewrite_goals_tac (Init_def::action_rews),
   7.176 +	    pcount.induct_tac "pc2 (fst_st sigma)" 1,
   7.177 +	    Auto_tac()
   7.178 +	   ]);
   7.179 +
   7.180 +(* Now prove that the first component will eventually reach pc1 = b from pc1 = a *)
   7.181 +
   7.182 +qed_goal "N1_enabled_at_both_a" Inc.thy
   7.183 +  "$pc2 .= #a .& (PsiInv .& $pc1 .= #a) .-> $(Enabled (<N1>_<x,y,sem,pc1,pc2>))"
   7.184 +  (fn _ => [Action_simp_tac 1,
   7.185 +	    res_inst_tac [("F","alpha1")] enabled_mono 1,
   7.186 +	    enabled_tac Inc_base 1,
   7.187 +	    auto_tac (Inc_css addIs2 [sym]
   7.188 +		              addsimps2 [angle_def,alpha1_def,N1_def] @ PsiInv_defs)
   7.189 +	   ]);
   7.190 +
   7.191 +qed_goal "a1_leadsto_b1" Inc.thy
   7.192 +  "[](PsiInv .& [(N1 .| N2) .& .~ beta1]_<x,y,sem,pc1,pc2>)              \
   7.193 +\            .& SF(N1)_<x,y,sem,pc1,pc2> .& [] SF(N2)_<x,y,sem,pc1,pc2>  \
   7.194 +\  .-> ($pc1 .= #a ~> $pc1 .= #b)"
   7.195 +  (fn _ => [rtac SF1 1,
   7.196 +	    SELECT_GOAL (auto_tac (Inc_css addsimps2 [square_def] @ Psi_defs)) 1,
   7.197 +	    SELECT_GOAL (auto_tac (Inc_css addsimps2 [angle_def] @ Psi_defs)) 1,
   7.198 +	    auto_tac (Inc_css addSIs2 [N1_enabled_at_both_a RS (temp_mp DmdImpl)]),
   7.199 +	    auto_tac (Inc_css addSIs2 [temp_mp BoxDmdT2, temp_mp N2_live]
   7.200 +		              addsimps2 split_box_conj::more_temp_simps)
   7.201 +	   ]);
   7.202 +
   7.203 +(* Combine the leadsto properties for N1: it will arrive at pc1 = b *)
   7.204 +
   7.205 +qed_goal "N1_leadsto_b" Inc.thy
   7.206 +  "[](PsiInv .& [(N1 .| N2) .& .~ beta1]_<x,y,sem,pc1,pc2>)              \
   7.207 +\            .& SF(N1)_<x,y,sem,pc1,pc2> .& [] SF(N2)_<x,y,sem,pc1,pc2>  \
   7.208 +\  .-> (($pc1 .= #b .| $pc1 .= #g .| $pc1 .= #a) ~> $pc1 .= #b)"
   7.209 +  (fn _ => [auto_tac (Inc_css addSIs2 [LatticeDisjunctionIntro]),
   7.210 +	    rtac (LatticeReflexivity RS tempD) 1,
   7.211 +	    rtac LatticeTransitivity 1,
   7.212 +	    auto_tac (Inc_css addSIs2 (map temp_mp [a1_leadsto_b1,g1_leadsto_a1])
   7.213 +		              addsimps2 [split_box_conj])
   7.214 +	   ]);
   7.215 +
   7.216 +qed_goal "N1_live" Inc.thy
   7.217 +  "[](PsiInv .& [(N1 .| N2) .& .~ beta1]_<x,y,sem,pc1,pc2>)              \
   7.218 +\            .& SF(N1)_<x,y,sem,pc1,pc2> .& [] SF(N2)_<x,y,sem,pc1,pc2>  \
   7.219 +\  .-> <>($pc1 .= #b)"
   7.220 +  (fn _ => [auto_tac (Inc_css addSIs2 [(temp_mp N1_leadsto_b) RSN(2,leadsto_init)]),
   7.221 +	    rewrite_goals_tac (Init_def::action_rews),
   7.222 +	    pcount.induct_tac "pc1 (fst_st sigma)" 1,
   7.223 +	    Auto_tac()
   7.224 +	   ]);
   7.225 +
   7.226 +qed_goal "N1_enabled_at_b" Inc.thy
   7.227 +  "($pc1 .= #b) .-> $(Enabled (<N1>_<x,y,sem,pc1,pc2>))"
   7.228 +  (fn _ => [Action_simp_tac 1,
   7.229 +	    res_inst_tac [("F","beta1")] enabled_mono 1,
   7.230 +	    enabled_tac Inc_base 1,
   7.231 +	    auto_tac (Inc_css addsimps2 [angle_def,beta1_def,N1_def])
   7.232 +	   ]);
   7.233 +
   7.234 +(* Now assemble the bits and pieces to prove that Psi is fair. *)
   7.235 +
   7.236 +qed_goal "Fair_M1_lemma" Inc.thy
   7.237 +  "[](PsiInv .& [(N1 .| N2)]_<x,y,sem,pc1,pc2>)              \
   7.238 +\            .& SF(N1)_<x,y,sem,pc1,pc2> .& [] SF(N2)_<x,y,sem,pc1,pc2>  \
   7.239 +\  .-> SF(M1)_<x,y>"
   7.240 +  (fn _ => [res_inst_tac [("B","beta1"),("P","$pc1 .= #b")] SF2 1,
   7.241 +	    (* the action premises are simple *)
   7.242 +	    SELECT_GOAL (auto_tac (Inc_css addsimps2 [angle_def,M1_def,beta1_def])) 1,
   7.243 +	    SELECT_GOAL (auto_tac (Inc_css addsimps2 angle_def::Psi_defs)) 1,
   7.244 +	    SELECT_GOAL (auto_tac (Inc_css addSEs2 [action_mp N1_enabled_at_b])) 1,
   7.245 +	    (* temporal premise: use previous lemmas and simple TL *)
   7.246 +	    auto_tac (Inc_css addSIs2 DmdStable::(map temp_mp [N1_live,Stuck_at_b]) 
   7.247 +                              addEs2 [STL4E]
   7.248 +		              addsimps2 [square_def])
   7.249 +	   ]);
   7.250 +
   7.251 +qed_goal "Fair_M1" Inc.thy "Psi .-> WF(M1)_<x,y>"
   7.252 +  (fn _ => [auto_tac (Inc_css addSIs2 SFImplWF::(map temp_mp [Fair_M1_lemma, PsiInv])
   7.253 +		              addsimps2 [split_box_conj]),
   7.254 +	    auto_tac (Inc_css addsimps2 Psi_def::more_temp_simps)
   7.255 +	   ]);
   7.256 +
     8.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     8.2 +++ b/src/HOL/TLA/Inc/Inc.thy	Wed Oct 08 11:50:33 1997 +0200
     8.3 @@ -0,0 +1,68 @@
     8.4 +(* 
     8.5 +    File:        TLA/ex/inc/Inc.thy
     8.6 +    Author:      Stephan Merz
     8.7 +    Copyright:   1997 University of Munich
     8.8 +
     8.9 +    Theory Name: Inc
    8.10 +    Logic Image: TLA
    8.11 +
    8.12 +    Lamport's "increment" example.
    8.13 +*)
    8.14 +
    8.15 +Inc  =  TLA + Nat + Pcount +
    8.16 +
    8.17 +consts
    8.18 +  (* program variables *)
    8.19 +  x,y,sem                 :: "nat stfun"
    8.20 +  pc1,pc2                 :: "pcount stfun"
    8.21 +
    8.22 +  (* names of actions and predicates *)
    8.23 +  M1,M2,N1,N2                             :: "action"
    8.24 +  alpha1,alpha2,beta1,beta2,gamma1,gamma2 :: "action"
    8.25 +  InitPhi, InitPsi                        :: "action"
    8.26 +  PsiInv,PsiInv1,PsiInv2,PsiInv3          :: "action"
    8.27 +
    8.28 +  (* temporal formulas *)
    8.29 +  Phi, Psi                                :: "temporal"
    8.30 +  
    8.31 +rules
    8.32 +  (* the "base" variables, required to compute enabledness predicates *)
    8.33 +  Inc_base      "base_var <x, y, sem, pc1, pc2>"
    8.34 +
    8.35 +  (* definitions for high-level program *)
    8.36 +  InitPhi_def   "InitPhi == ($x .= # 0) .& ($y .= # 0)"
    8.37 +  M1_def        "M1      == (x$ .= Suc[$x]) .& (y$ .= $y)"
    8.38 +  M2_def        "M2      == (y$ .= Suc[$y]) .& (x$ .= $x)"
    8.39 +  Phi_def       "Phi     == Init(InitPhi) .& [][M1 .| M2]_<x,y> .&   \
    8.40 +\                           WF(M1)_<x,y> .& WF(M2)_<x,y>"
    8.41 +
    8.42 +  (* definitions for low-level program *)
    8.43 +  InitPsi_def   "InitPsi == ($pc1 .= #a) .& ($pc2 .= #a) .&   \
    8.44 +\                           ($x .= # 0) .& ($y .= # 0) .& ($sem .= Suc[# 0])"
    8.45 +  alpha1_def    "alpha1  == ($pc1 .= #a) .& (pc1$ .= #b) .& ($sem .= Suc[sem$]) .&   \
    8.46 +\                           unchanged(<x,y,pc2>)"
    8.47 +  alpha2_def    "alpha2  == ($pc2 .= #a) .& (pc2$ .= #b) .& ($sem .= Suc[sem$]) .&   \
    8.48 +\                           unchanged(<x,y,pc1>)"
    8.49 +  beta1_def     "beta1   == ($pc1 .= #b) .& (pc1$ .= #g) .& (x$ .= Suc[$x]) .&   \
    8.50 +\                           unchanged(<y,sem,pc2>)"
    8.51 +  beta2_def     "beta2   == ($pc2 .= #b) .& (pc2$ .= #g) .& (y$ .= Suc[$y]) .&   \
    8.52 +\                           unchanged(<x,sem,pc1>)"
    8.53 +  gamma1_def    "gamma1  == ($pc1 .= #g) .& (pc1$ .= #a) .& (sem$ .= Suc[$sem]) .&   \
    8.54 +\                           unchanged(<x,y,pc2>)"
    8.55 +  gamma2_def    "gamma2  == ($pc2 .= #g) .& (pc2$ .= #a) .& (sem$ .= Suc[$sem]) .&   \
    8.56 +\                           unchanged(<x,y,pc1>)"
    8.57 +  N1_def        "N1      == alpha1 .| beta1 .| gamma1"
    8.58 +  N2_def        "N2      == alpha2 .| beta2 .| gamma2"
    8.59 +  Psi_def       "Psi     == Init(InitPsi)   \
    8.60 +\                           .& [][N1 .| N2]_<x,y,sem,pc1,pc2>  \
    8.61 +\                           .& SF(N1)_<x,y,sem,pc1,pc2>  \
    8.62 +\                           .& SF(N2)_<x,y,sem,pc1,pc2>"
    8.63 +
    8.64 +  PsiInv1_def  "PsiInv1  == ($sem .= Suc[# 0]) .& ($pc1 .= #a) .& ($pc2 .= #a)"
    8.65 +  PsiInv2_def  "PsiInv2  == ($sem .= # 0) .& ($pc1 .= #a) .& ($pc2 .= #b .| $pc2 .= #g)"
    8.66 +  PsiInv3_def  "PsiInv3  == ($sem .= # 0) .& ($pc2 .= #a) .& ($pc1 .= #b .| $pc1 .= #g)"
    8.67 +  PsiInv_def   "PsiInv   == PsiInv1 .| PsiInv2 .| PsiInv3"
    8.68 +  
    8.69 +end
    8.70 +
    8.71 +ML
     9.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     9.2 +++ b/src/HOL/TLA/Inc/Pcount.thy	Wed Oct 08 11:50:33 1997 +0200
     9.3 @@ -0,0 +1,20 @@
     9.4 +(* 
     9.5 +    File:	 TLA/ex/inc/Pcount.thy
     9.6 +    Author:      Stephan Merz
     9.7 +    Copyright:   1997 University of Munich
     9.8 +
     9.9 +    Theory Name: Pcount
    9.10 +    Logic Image: TLA
    9.11 +
    9.12 +Data type "program counter" for the increment example.
    9.13 +Isabelle/HOL's datatype package generates useful simplifications
    9.14 +and case distinction tactics.
    9.15 +*)
    9.16 +
    9.17 +Pcount  =  HOL + Arith +
    9.18 +
    9.19 +datatype pcount = a | b | g
    9.20 +
    9.21 +end
    9.22 +
    9.23 +ML
    10.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    10.2 +++ b/src/HOL/TLA/IntLemmas.ML	Wed Oct 08 11:50:33 1997 +0200
    10.3 @@ -0,0 +1,392 @@
    10.4 +(* 
    10.5 +    File:	 IntLemmas.ML
    10.6 +    Author:      Stephan Merz
    10.7 +    Copyright:   1997 University of Munich
    10.8 +
    10.9 +Lemmas and tactics for "intensional" logics. 
   10.10 +
   10.11 +Mostly a lifting of standard HOL lemmas. They are not required in standard
   10.12 +reasoning about intensional logics, which starts by unlifting proof goals
   10.13 +to the HOL level.
   10.14 +*)
   10.15 +
   10.16 +
   10.17 +qed_goal "substW" Intensional.thy
   10.18 +  "[| x .= y; w |= (P::[('v::world) => 'a, 'w::world] => bool)(x) |] ==> w |= P(y)"
   10.19 +  (fn [prem1,prem2] => [rtac (rewrite_rule ([prem1] RL [inteq_reflection]) prem2) 1]);
   10.20 +                        
   10.21 +
   10.22 +(* Lift HOL rules to intensional reasoning *)
   10.23 +
   10.24 +qed_goal "reflW" Intensional.thy "x .= x"
   10.25 +  (fn _ => [ rtac intI 1,
   10.26 +             rewrite_goals_tac intensional_rews,
   10.27 +             rtac refl 1 ]);
   10.28 +
   10.29 +
   10.30 +qed_goal "symW" Intensional.thy "s .= t ==> t .= s"
   10.31 +  (fn prems => [ cut_facts_tac prems 1,
   10.32 +                 rtac intI 1, dtac intD 1,
   10.33 +                 rewrite_goals_tac intensional_rews,
   10.34 +                 etac sym 1 ]);
   10.35 +
   10.36 +qed_goal "not_symW" Intensional.thy "s .~= t ==> t .~= s"
   10.37 +  (fn prems => [ cut_facts_tac prems 1,
   10.38 +                 rtac intI 1, dtac intD 1,
   10.39 +                 rewrite_goals_tac intensional_rews,
   10.40 +                 etac not_sym 1 ]);
   10.41 +
   10.42 +qed_goal "transW" Intensional.thy 
   10.43 +  "[| r .= s; s .= t |] ==> r .= t"
   10.44 +  (fn prems => [ cut_facts_tac prems 1,
   10.45 +                 rtac intI 1, REPEAT (dtac intD 1),
   10.46 +                 rewrite_goals_tac intensional_rews,
   10.47 +                 etac trans 1,
   10.48 +                 atac 1 ]);
   10.49 +
   10.50 +qed_goal "box_equalsW" Intensional.thy 
   10.51 +   "[| a .= b; a .= c; b .= d |] ==> c .= d"
   10.52 +   (fn prems => [ (rtac transW 1),
   10.53 +                  (rtac transW 1),
   10.54 +                  (rtac symW 1),
   10.55 +                  (REPEAT (resolve_tac prems 1)) ]);
   10.56 +
   10.57 +
   10.58 +qed_goal "fun_congW" Intensional.thy 
   10.59 +   "(f::('a => 'b)) = g ==> f[x] .= g[x]"
   10.60 +   (fn prems => [ cut_facts_tac prems 1,
   10.61 +                  rtac intI 1,
   10.62 +                  rewrite_goals_tac intensional_rews,
   10.63 +                  etac fun_cong 1 ]);
   10.64 +
   10.65 +qed_goal "fun_cong2W" Intensional.thy 
   10.66 +   "(f::(['a,'b] => 'c)) = g ==> f[x,y] .= g[x,y]"
   10.67 +   (fn prems => [ cut_facts_tac prems 1,
   10.68 +                  rtac intI 1,
   10.69 +                  rewrite_goals_tac intensional_rews,
   10.70 +                  asm_full_simp_tac HOL_ss 1 ]);
   10.71 +
   10.72 +qed_goal "fun_cong3W" Intensional.thy 
   10.73 +   "(f::(['a,'b,'c] => 'd)) = g ==> f[x,y,z] .= g[x,y,z]"
   10.74 +   (fn prems => [ cut_facts_tac prems 1,
   10.75 +                  rtac intI 1,
   10.76 +                  rewrite_goals_tac intensional_rews,
   10.77 +                  asm_full_simp_tac HOL_ss 1 ]);
   10.78 +
   10.79 +
   10.80 +qed_goal "arg_congW" Intensional.thy "x .= y ==> (f::'a=>'b)[x] .= f[y]"
   10.81 +   (fn prems => [ cut_facts_tac prems 1,
   10.82 +                  rtac intI 1,
   10.83 +                  dtac intD 1,
   10.84 +                  rewrite_goals_tac intensional_rews,
   10.85 +                  etac arg_cong 1 ]);
   10.86 +
   10.87 +qed_goal "arg_cong2W" Intensional.thy 
   10.88 +   "[| u .= v; x .= y |] ==> (f::['a,'b]=>'c)[u,x] .= f[v,y]"
   10.89 +   (fn prems => [ cut_facts_tac prems 1,
   10.90 +                  rtac intI 1,
   10.91 +                  REPEAT (dtac intD 1),
   10.92 +                  rewrite_goals_tac intensional_rews,
   10.93 +                  REPEAT (etac subst 1),
   10.94 +                  rtac refl 1 ]);
   10.95 +
   10.96 +qed_goal "arg_cong3W" Intensional.thy 
   10.97 +   "[| r .= s; u .= v; x .= y |] ==> (f::['a,'b,'c]=>'d)[r,u,x] .= f[s,v,y]"
   10.98 +   (fn prems => [ cut_facts_tac prems 1,
   10.99 +                  rtac intI 1,
  10.100 +                  REPEAT (dtac intD 1),
  10.101 +                  rewrite_goals_tac intensional_rews,
  10.102 +                  REPEAT (etac subst 1),
  10.103 +                  rtac refl 1 ]);
  10.104 +
  10.105 +qed_goal "congW" Intensional.thy 
  10.106 +   "[| (f::'a=>'b) = g; x .= y |] ==> f[x] .= g[y]"
  10.107 +   (fn prems => [ rtac box_equalsW 1,
  10.108 +                  rtac reflW 3,
  10.109 +                  rtac arg_congW 1,
  10.110 +                  resolve_tac prems 1,
  10.111 +                  rtac fun_congW 1,
  10.112 +                  rtac sym 1,
  10.113 +                  resolve_tac prems 1 ]);
  10.114 +
  10.115 +qed_goal "cong2W" Intensional.thy 
  10.116 +   "[| (f::['a,'b]=>'c) = g; u .= v; x .= y |] ==> f[u,x] .= g[v,y]"
  10.117 +   (fn prems => [ rtac box_equalsW 1,
  10.118 +                  rtac reflW 3,
  10.119 +                  rtac arg_cong2W 1,
  10.120 +                  REPEAT (resolve_tac prems 1),
  10.121 +                  rtac fun_cong2W 1,
  10.122 +                  rtac sym 1,
  10.123 +                  resolve_tac prems 1 ]);
  10.124 +
  10.125 +qed_goal "cong3W" Intensional.thy 
  10.126 +   "[| (f::['a,'b,'c]=>'d) = g; r .= s; u .= v; x .= y |] ==> (f[r,u,x]) .= (g[s,v,y])"
  10.127 +   (fn prems => [ rtac box_equalsW 1,
  10.128 +                  rtac reflW 3,
  10.129 +                  rtac arg_cong3W 1,
  10.130 +                  REPEAT (resolve_tac prems 1),
  10.131 +                  rtac fun_cong3W 1,
  10.132 +                  rtac sym 1,
  10.133 +                  resolve_tac prems 1 ]);
  10.134 +
  10.135 +
  10.136 +(** Lifted equivalence **)
  10.137 +
  10.138 +(* Note the object-level implication in the hypothesis. Meta-level implication
  10.139 +   would not be correct! *)
  10.140 +qed_goal "iffIW" Intensional.thy 
  10.141 +  "[| A .-> B; B .-> A |] ==> A .= B"
  10.142 +  (fn prems => [ cut_facts_tac prems 1,
  10.143 +                 rtac intI 1,
  10.144 +                 REPEAT (dtac intD 1),
  10.145 +                 rewrite_goals_tac intensional_rews,
  10.146 +                 (fast_tac prop_cs 1) ]);
  10.147 +
  10.148 +qed_goal "iffD2W" Intensional.thy 
  10.149 +  "[| (P::('w::world) form) .= Q; w |= Q |] ==> w |= P"
  10.150 + (fn prems =>
  10.151 +	[cut_facts_tac prems 1,
  10.152 +         dtac intD 1,
  10.153 +         rewrite_goals_tac intensional_rews,
  10.154 +         fast_tac prop_cs 1 ]);
  10.155 +
  10.156 +val iffD1W = symW RS iffD2W;
  10.157 +
  10.158 +(** #True **)
  10.159 +
  10.160 +qed_goal "TrueIW" Intensional.thy "#True"
  10.161 +  (fn _ => [rtac intI 1, rewrite_goals_tac intensional_rews, rtac TrueI 1]);
  10.162 +
  10.163 +
  10.164 +qed_goal "eqTrueIW" Intensional.thy "(P::('w::world) form) ==> P .= #True"
  10.165 +  (fn prems => [cut_facts_tac prems 1,
  10.166 +                rtac intI 1,
  10.167 +                dtac intD 1,
  10.168 +                rewrite_goals_tac intensional_rews,
  10.169 +                asm_full_simp_tac HOL_ss 1] );
  10.170 +
  10.171 +qed_goal "eqTrueEW" Intensional.thy "P .= #True ==> (P::('w::world) form)" 
  10.172 +  (fn prems => [cut_facts_tac prems 1,
  10.173 +                rtac intI 1,
  10.174 +                dtac intD 1,
  10.175 +                rewrite_goals_tac intensional_rews,
  10.176 +                asm_full_simp_tac HOL_ss 1] );
  10.177 +
  10.178 +(** #False **)
  10.179 +
  10.180 +qed_goal "FalseEW" Intensional.thy "#False ==> P::('w::world) form"
  10.181 +  (fn prems => [cut_facts_tac prems 1,
  10.182 +                rtac intI 1,
  10.183 +                dtac intD 1,
  10.184 +                rewrite_goals_tac intensional_rews,
  10.185 +                etac FalseE 1]);
  10.186 +
  10.187 +qed_goal "False_neq_TrueW" Intensional.thy 
  10.188 + "(#False::('w::world) form) .= #True ==> P::('w::world) form"
  10.189 + (fn [prem] => [rtac (prem RS eqTrueEW RS FalseEW) 1]);
  10.190 +
  10.191 +
  10.192 +(** Negation **)
  10.193 +
  10.194 +(* Again use object-level implication *)
  10.195 +qed_goal "notIW" Intensional.thy "(P .-> #False) ==> .~P"
  10.196 +  (fn prems => [cut_facts_tac prems 1,
  10.197 +                rtac intI 1,
  10.198 +                dtac intD 1,
  10.199 +                rewrite_goals_tac intensional_rews,
  10.200 +                fast_tac prop_cs 1]);
  10.201 +
  10.202 +
  10.203 +qed_goal "notEWV" Intensional.thy 
  10.204 +  "[| .~P; P::('w::world) form |] ==> R::('w::world) form"
  10.205 +  (fn prems => [cut_facts_tac prems 1,
  10.206 +		rtac intI 1,
  10.207 +                REPEAT (dtac intD 1),
  10.208 +                rewrite_goals_tac intensional_rews,
  10.209 +                etac notE 1, atac 1]);
  10.210 +
  10.211 +(* The following rule is stronger: It is enough to detect an 
  10.212 +   inconsistency at *some* world to conclude R. Note also that P and R
  10.213 +   are allowed to be (intensional) formulas of different types! *)
  10.214 +
  10.215 +qed_goal "notEW" Intensional.thy 
  10.216 +   "[| w |= .~P; w |= P |] ==> R::('w::world) form"
  10.217 +  (fn prems => [cut_facts_tac prems 1,
  10.218 +                rtac intI 1,
  10.219 +                rewrite_goals_tac intensional_rews,
  10.220 +                etac notE 1, atac 1]);
  10.221 +
  10.222 +(** Implication **)
  10.223 +
  10.224 +qed_goal "impIW" Intensional.thy "(!!w. (w |= A) ==> (w |= B)) ==> A .-> B"
  10.225 +  (fn [prem] => [ rtac intI 1,
  10.226 +                 rewrite_goals_tac intensional_rews,
  10.227 +                 rtac impI 1,
  10.228 +                 etac prem 1 ]);
  10.229 +
  10.230 +
  10.231 +qed_goal "mpW" Intensional.thy "[| A .-> B; w |= A |] ==> w |= B"
  10.232 +   (fn prems => [ cut_facts_tac prems 1,
  10.233 +                  dtac intD 1,
  10.234 +                  rewrite_goals_tac intensional_rews,
  10.235 +                  etac mp 1,
  10.236 +                  atac 1 ]);
  10.237 +
  10.238 +qed_goal "impEW" Intensional.thy 
  10.239 +  "[| A .-> B; w |= A; w |= B ==> w |= C |] ==> w |= (C::('w::world) form)"
  10.240 +  (fn prems => [ (REPEAT (resolve_tac (prems@[mpW]) 1)) ]);
  10.241 +
  10.242 +qed_goal "rev_mpW" Intensional.thy "[| w |= P; P .-> Q |] ==> w |= Q"
  10.243 +  (fn prems => [ (REPEAT (resolve_tac (prems@[mpW]) 1)) ]);
  10.244 +
  10.245 +qed_goal "contraposW" Intensional.thy "[| w |= .~Q; P .-> Q |] ==> w |= .~P"
  10.246 +  (fn [major,minor] => [rewrite_goals_tac intensional_rews,
  10.247 +                        rtac contrapos 1,
  10.248 +                        rtac (rewrite_rule intensional_rews major) 1,
  10.249 +                        etac rev_mpW 1,
  10.250 +                        rtac minor 1]);
  10.251 +
  10.252 +qed_goal "iffEW" Intensional.thy
  10.253 +    "[| (P::('w::world) form) .= Q; [| P .-> Q; Q .-> P |] ==> R::('w::world) form |] ==> R"
  10.254 + (fn [p1,p2] => [REPEAT(ares_tac([p1 RS iffD2W, p1 RS iffD1W, p2, impIW])1)]);
  10.255 +
  10.256 +
  10.257 +(** Conjunction **)
  10.258 +
  10.259 +qed_goal "conjIW" Intensional.thy "[| w |= P; w |= Q |] ==> w |= P .& Q"
  10.260 +  (fn prems => [rewrite_goals_tac intensional_rews,
  10.261 +                REPEAT (resolve_tac ([conjI]@prems) 1)]);
  10.262 +
  10.263 +qed_goal "conjunct1W" Intensional.thy "(w |= P .& Q) ==> w |= P"
  10.264 +  (fn prems => [cut_facts_tac prems 1,
  10.265 +                rewrite_goals_tac intensional_rews,
  10.266 +                etac conjunct1 1]);
  10.267 +
  10.268 +qed_goal "conjunct2W" Intensional.thy "(w |= P .& Q) ==> w |= Q"
  10.269 +  (fn prems => [cut_facts_tac prems 1,
  10.270 +                rewrite_goals_tac intensional_rews,
  10.271 +                etac conjunct2 1]);
  10.272 +
  10.273 +qed_goal "conjEW" Intensional.thy 
  10.274 +  "[| w |= P .& Q; [| w |= P; w |= Q |] ==> w |= R |] ==> w |= (R::('w::world) form)"
  10.275 +  (fn prems => [cut_facts_tac prems 1, resolve_tac prems 1,
  10.276 +	        etac conjunct1W 1, etac conjunct2W 1]);
  10.277 +
  10.278 +
  10.279 +(** Disjunction **)
  10.280 +
  10.281 +qed_goal "disjI1W" Intensional.thy "w |= P ==> w |= P .| Q"
  10.282 +  (fn [prem] => [rewrite_goals_tac intensional_rews,
  10.283 +                 rtac disjI1 1,
  10.284 +                 rtac prem 1]);
  10.285 +
  10.286 +qed_goal "disjI2W" Intensional.thy "w |= Q ==> w |= P .| Q"
  10.287 +  (fn [prem] => [rewrite_goals_tac intensional_rews,
  10.288 +                 rtac disjI2 1,
  10.289 +                 rtac prem 1]);
  10.290 +
  10.291 +qed_goal "disjEW" Intensional.thy 
  10.292 +         "[| w |= P .| Q; P .-> R; Q .-> R |] ==> w |= R"
  10.293 +  (fn prems => [cut_facts_tac prems 1,
  10.294 +                REPEAT (dtac intD 1),
  10.295 +                rewrite_goals_tac intensional_rews,
  10.296 +                fast_tac prop_cs 1]);
  10.297 +
  10.298 +(** Classical propositional logic **)
  10.299 +
  10.300 +qed_goal "classicalW" Intensional.thy "(.~P .-> P) ==> P::('w::world)form"
  10.301 +  (fn prems => [cut_facts_tac prems 1,
  10.302 +                rtac intI 1,
  10.303 +                dtac intD 1,
  10.304 +                rewrite_goals_tac intensional_rews,
  10.305 +                fast_tac prop_cs 1]);
  10.306 +
  10.307 +qed_goal "notnotDW" Intensional.thy ".~.~P ==> P::('w::world) form"
  10.308 +  (fn prems => [cut_facts_tac prems 1,
  10.309 +                rtac intI 1,
  10.310 +                dtac intD 1,
  10.311 +                rewrite_goals_tac intensional_rews,
  10.312 +                etac notnotD 1]);
  10.313 +
  10.314 +qed_goal "disjCIW" Intensional.thy "(w |= .~Q .-> P) ==> (w |= P.|Q)"
  10.315 +  (fn prems => [cut_facts_tac prems 1,
  10.316 +                rewrite_goals_tac intensional_rews,
  10.317 +                fast_tac prop_cs 1]);
  10.318 +
  10.319 +qed_goal "impCEW" Intensional.thy 
  10.320 +   "[| P.->Q; (w |= .~P) ==> (w |= R); (w |= Q) ==> (w |= R) |] ==> w |= (R::('w::world) form)"
  10.321 +  (fn [a1,a2,a3] => 
  10.322 +    [rtac (excluded_middle RS disjE) 1,
  10.323 +     etac (rewrite_rule intensional_rews a2) 1,
  10.324 +     rtac a3 1,
  10.325 +     etac (a1 RS mpW) 1]);
  10.326 +
  10.327 +(* The following generates too many parse trees...
  10.328 +
  10.329 +qed_goal "iffCEW" Intensional.thy
  10.330 +   "[| P .= Q;      \
  10.331 +\      [| (w |= P); (w |= Q) |] ==> (w |= R);   \
  10.332 +\      [| (w |= .~P); (w |= .~Q) |] ==> (w |= R)  \
  10.333 +\   |] ==> w |= (R::('w::world) form)"
  10.334 +
  10.335 +*)
  10.336 +
  10.337 +qed_goal "case_split_thmW" Intensional.thy 
  10.338 +   "[| P .-> Q; .~P .-> Q |] ==> Q::('w::world) form"
  10.339 +  (fn prems => [cut_facts_tac prems 1,
  10.340 +                rtac intI 1,
  10.341 +                REPEAT (dtac intD 1),
  10.342 +                rewrite_goals_tac intensional_rews,
  10.343 +                fast_tac prop_cs 1]);
  10.344 +
  10.345 +fun case_tacW a = res_inst_tac [("P",a)] case_split_thmW;
  10.346 +
  10.347 +
  10.348 +(** Rigid quantifiers **)
  10.349 +
  10.350 +qed_goal "allIW" Intensional.thy "(!!x. P(x)) ==> RALL x. P(x)"
  10.351 +  (fn [prem] => [rtac intI 1,
  10.352 +                 rewrite_goals_tac intensional_rews,
  10.353 +                 rtac allI 1,
  10.354 +                 rtac (prem RS intE) 1]);
  10.355 +
  10.356 +qed_goal "specW" Intensional.thy "(RALL x. P(x)) ==> P(x)"
  10.357 +  (fn prems => [cut_facts_tac prems 1,
  10.358 +                rtac intI 1,
  10.359 +                dtac intD 1,
  10.360 +                rewrite_goals_tac intensional_rews,
  10.361 +                etac spec 1]);
  10.362 +
  10.363 +
  10.364 +qed_goal "allEW" Intensional.thy 
  10.365 +         "[| RALL x.P(x);  P(x) ==> R |] ==> R::('w::world) form"
  10.366 + (fn major::prems=>
  10.367 +  [ (REPEAT (resolve_tac (prems @ [major RS specW]) 1)) ]);
  10.368 +
  10.369 +qed_goal "all_dupEW" Intensional.thy 
  10.370 +    "[| RALL x.P(x);  [| P(x); RALL x.P(x) |] ==> R |] ==> R::('w::world) form"
  10.371 + (fn prems =>
  10.372 +  [ (REPEAT (resolve_tac (prems @ (prems RL [specW])) 1)) ]);
  10.373 +
  10.374 +
  10.375 +qed_goal "exIW" Intensional.thy "P(x) ==> REX x.P(x)"
  10.376 +  (fn [prem] => [rtac intI 1,
  10.377 +                 rewrite_goals_tac intensional_rews,
  10.378 +                 rtac exI 1,
  10.379 +                 rtac (prem RS intD) 1]);
  10.380 +
  10.381 +qed_goal "exEW" Intensional.thy 
  10.382 +  "[| w |= REX x.P(x); !!x. P(x) .-> Q |] ==> w |= Q"
  10.383 +  (fn [major,minor] => [rtac exE 1,
  10.384 +                        rtac (rewrite_rule intensional_rews major) 1,
  10.385 +                        etac rev_mpW 1,
  10.386 +                        rtac minor 1]);
  10.387 +
  10.388 +(** Classical quantifier reasoning **)
  10.389 +
  10.390 +qed_goal "exCIW" Intensional.thy 
  10.391 +  "(w |= (RALL x. .~P(x)) .-> P(a)) ==> w |= REX x.P(x)"
  10.392 +  (fn prems => [cut_facts_tac prems 1,
  10.393 +                rewrite_goals_tac intensional_rews,
  10.394 +                fast_tac HOL_cs 1]);
  10.395 +
    11.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    11.2 +++ b/src/HOL/TLA/Intensional.ML	Wed Oct 08 11:50:33 1997 +0200
    11.3 @@ -0,0 +1,209 @@
    11.4 +(* 
    11.5 +    File:	 Intensional.ML
    11.6 +    Author:      Stephan Merz
    11.7 +    Copyright:   1997 University of Munich
    11.8 +
    11.9 +Lemmas and tactics for "intensional" logics.
   11.10 +*)
   11.11 +
   11.12 +val intensional_rews = [unl_con,unl_lift,unl_lift2,unl_lift3,unl_Rall,unl_Rex];
   11.13 +
   11.14 +(** Lift usual HOL simplifications to "intensional" level. 
   11.15 +    Convert s .= t into rewrites s == t, so we can use the standard 
   11.16 +    simplifier.
   11.17 +**)
   11.18 +local
   11.19 +
   11.20 +fun prover s = (prove_goal Intensional.thy s 
   11.21 +                 (fn _ => [rewrite_goals_tac (int_valid::intensional_rews), 
   11.22 +                           blast_tac HOL_cs 1])) RS inteq_reflection;
   11.23 +
   11.24 +in
   11.25 +
   11.26 +val int_simps = map prover
   11.27 + [ "(x.=x) .= #True",
   11.28 +   "(.~#True) .= #False", "(.~#False) .= #True", "(.~ .~ P) .= P",
   11.29 +   "((.~P) .= P) .= #False", "(P .= (.~P)) .= #False", 
   11.30 +   "(P .~= Q) .= (P .= (.~Q))",
   11.31 +   "(#True.=P) .= P", "(P.=#True) .= P",
   11.32 +   "(#True .-> P) .= P", "(#False .-> P) .= #True", 
   11.33 +   "(P .-> #True) .= #True", "(P .-> P) .= #True",
   11.34 +   "(P .-> #False) .= (.~P)", "(P .-> .~P) .= (.~P)",
   11.35 +   "(P .& #True) .= P", "(#True .& P) .= P", 
   11.36 +   "(P .& #False) .= #False", "(#False .& P) .= #False", 
   11.37 +   "(P .& P) .= P", "(P .& .~P) .= #False", "(.~P .& P) .= #False",
   11.38 +   "(P .| #True) .= #True", "(#True .| P) .= #True", 
   11.39 +   "(P .| #False) .= P", "(#False .| P) .= P", 
   11.40 +   "(P .| P) .= P", "(P .| .~P) .= #True", "(.~P .| P) .= #True",
   11.41 +   "(RALL x.P) .= P", "(REX x.P) .= P",
   11.42 +   "(.~Q .-> .~P) .= (P .-> Q)",
   11.43 +   "(P.|Q .-> R) .= ((P.->R).&(Q.->R))" ];
   11.44 +
   11.45 +end;
   11.46 +
   11.47 +Addsimps (intensional_rews @ int_simps);
   11.48 +
   11.49 +(* Derive introduction and destruction rules from definition of 
   11.50 +   intensional validity.
   11.51 +*)
   11.52 +qed_goal "intI" Intensional.thy "(!!w. w |= A) ==> A"
   11.53 +  (fn prems => [rewtac int_valid,
   11.54 +                resolve_tac prems 1
   11.55 +               ]);
   11.56 +
   11.57 +qed_goalw "intD" Intensional.thy [int_valid] "A ==> w |= A"
   11.58 +  (fn [prem] => [ rtac (forall_elim_var 0 prem) 1 ]);
   11.59 +
   11.60 +(* ======== Functions to "unlift" intensional implications into HOL rules ====== *)
   11.61 +
   11.62 +(* Basic unlifting introduces a parameter "w" and applies basic rewrites, e.g.
   11.63 +   F .= G    gets   (w |= F) = (w |= G)
   11.64 +   F .-> G   gets   (w |= F) --> (w |= G)
   11.65 +*)
   11.66 +fun int_unlift th = rewrite_rule intensional_rews (th RS intD);
   11.67 +
   11.68 +(* F .-> G   becomes   w |= F  ==>  w |= G *)
   11.69 +fun int_mp th = zero_var_indexes ((int_unlift th) RS mp);
   11.70 +
   11.71 +(* F .-> G   becomes   [| w |= F; w |= G ==> R |] ==> R 
   11.72 +   so that it can be used as an elimination rule
   11.73 +*)
   11.74 +fun int_impE th = zero_var_indexes ((int_unlift th) RS impE);
   11.75 +
   11.76 +(* F .& G .-> H  becomes  [| w |= F; w |= G |] ==> w |= H *)
   11.77 +fun int_conjmp th = zero_var_indexes (conjI RS (int_mp th));
   11.78 +
   11.79 +(* F .& G .-> H  becomes  [| w |= F; w |= G; (w |= H ==> R) |] ==> R *)
   11.80 +fun int_conjimpE th = zero_var_indexes (conjI RS (int_impE th));
   11.81 +
   11.82 +(* Turn  F .= G  into meta-level rewrite rule  F == G *)
   11.83 +fun int_rewrite th = (rewrite_rule intensional_rews (th RS inteq_reflection));
   11.84 +
   11.85 +(* Make the simplifier accept "intensional" goals by first unlifting them.
   11.86 +   This is the standard way of proving "intensional" theorems; apply
   11.87 +   int_rewrite (or action_rewrite, temp_rewrite) to convert "x .= y" into "x == y"
   11.88 +   if you want to rewrite without unlifting.
   11.89 +*)
   11.90 +fun maybe_unlift th =
   11.91 +    (case concl_of th of
   11.92 +	 Const("TrueInt",_) $ p => int_unlift th
   11.93 +       | _ => th);
   11.94 +
   11.95 +simpset := !simpset setmksimps ((mksimps mksimps_pairs) o maybe_unlift);
   11.96 +
   11.97 +
   11.98 +(* ==================== Rewrites for abstractions ==================== *)
   11.99 +
  11.100 +(* The following are occasionally useful. Don't add them to the default
  11.101 +   simpset, or it will loop! Alternatively, we could replace the "unl_XXX"
  11.102 +   rules by definitions of lifting via lambda abstraction, but then proof
  11.103 +   states would have lots of lambdas, and would be hard to read.
  11.104 +*)
  11.105 +
  11.106 +qed_goal "con_abs" Intensional.thy "(%w. c) == #c"
  11.107 +  (fn _ => [rtac inteq_reflection 1,
  11.108 +            rtac intI 1,
  11.109 +            rewrite_goals_tac intensional_rews,
  11.110 +            rtac refl 1
  11.111 +           ]);
  11.112 +
  11.113 +qed_goal "lift_abs" Intensional.thy "(%w. f(x w)) == (f[x])"
  11.114 +  (fn _ => [rtac inteq_reflection 1,
  11.115 +            rtac intI 1,
  11.116 +            rewrite_goals_tac intensional_rews,
  11.117 +            rtac refl 1
  11.118 +           ]);
  11.119 +
  11.120 +qed_goal "lift2_abs" Intensional.thy "(%w. f(x w) (y w)) == (f[x,y])"
  11.121 +  (fn _ => [rtac inteq_reflection 1,
  11.122 +            rtac intI 1,
  11.123 +            rewrite_goals_tac intensional_rews,
  11.124 +            rtac refl 1
  11.125 +           ]);
  11.126 +
  11.127 +qed_goal "lift2_abs_con1" Intensional.thy "(%w. f x (y w)) == (f[#x,y])"
  11.128 +  (fn _ => [rtac inteq_reflection 1,
  11.129 +            rtac intI 1,
  11.130 +            rewrite_goals_tac intensional_rews,
  11.131 +            rtac refl 1
  11.132 +           ]);
  11.133 +
  11.134 +qed_goal "lift2_abs_con2" Intensional.thy "(%w. f(x w) y) == (f[x,#y])"
  11.135 +  (fn _ => [rtac inteq_reflection 1,
  11.136 +            rtac intI 1,
  11.137 +            rewrite_goals_tac intensional_rews,
  11.138 +            rtac refl 1
  11.139 +           ]);
  11.140 +
  11.141 +qed_goal "lift3_abs" Intensional.thy "(%w. f(x w) (y w) (z w)) == (f[x,y,z])"
  11.142 +  (fn _ => [rtac inteq_reflection 1,
  11.143 +            rtac intI 1,
  11.144 +            rewrite_goals_tac intensional_rews,
  11.145 +            rtac refl 1
  11.146 +           ]);
  11.147 +
  11.148 +qed_goal "lift3_abs_con1" Intensional.thy "(%w. f x (y w) (z w)) == (f[#x,y,z])"
  11.149 +  (fn _ => [rtac inteq_reflection 1,
  11.150 +            rtac intI 1,
  11.151 +            rewrite_goals_tac intensional_rews,
  11.152 +            rtac refl 1
  11.153 +           ]);
  11.154 +
  11.155 +qed_goal "lift3_abs_con2" Intensional.thy "(%w. f (x w) y (z w)) == (f[x,#y,z])"
  11.156 +  (fn _ => [rtac inteq_reflection 1,
  11.157 +            rtac intI 1,
  11.158 +            rewrite_goals_tac intensional_rews,
  11.159 +            rtac refl 1
  11.160 +           ]);
  11.161 +
  11.162 +qed_goal "lift3_abs_con3" Intensional.thy "(%w. f (x w) (y w) z) == (f[x,y,#z])"
  11.163 +  (fn _ => [rtac inteq_reflection 1,
  11.164 +            rtac intI 1,
  11.165 +            rewrite_goals_tac intensional_rews,
  11.166 +            rtac refl 1
  11.167 +           ]);
  11.168 +
  11.169 +qed_goal "lift3_abs_con12" Intensional.thy "(%w. f x y (z w)) == (f[#x,#y,z])"
  11.170 +  (fn _ => [rtac inteq_reflection 1,
  11.171 +            rtac intI 1,
  11.172 +            rewrite_goals_tac intensional_rews,
  11.173 +            rtac refl 1
  11.174 +           ]);
  11.175 +
  11.176 +qed_goal "lift3_abs_con13" Intensional.thy "(%w. f x (y w) z) == (f[#x,y,#z])"
  11.177 +  (fn _ => [rtac inteq_reflection 1,
  11.178 +            rtac intI 1,
  11.179 +            rewrite_goals_tac intensional_rews,
  11.180 +            rtac refl 1
  11.181 +           ]);
  11.182 +
  11.183 +qed_goal "lift3_abs_con23" Intensional.thy "(%w. f (x w) y z) == (f[x,#y,#z])"
  11.184 +  (fn _ => [rtac inteq_reflection 1,
  11.185 +            rtac intI 1,
  11.186 +            rewrite_goals_tac intensional_rews,
  11.187 +            rtac refl 1
  11.188 +           ]);
  11.189 +
  11.190 +(* ========================================================================= *)
  11.191 +
  11.192 +qed_goal "Not_rall" Intensional.thy
  11.193 +   "(.~ (RALL x. F(x))) .= (REX x. .~ F(x))"
  11.194 +   (fn _ => [rtac intI 1,
  11.195 +	     rewrite_goals_tac intensional_rews,
  11.196 +	     fast_tac HOL_cs 1
  11.197 +	    ]);
  11.198 +
  11.199 +qed_goal "Not_rex" Intensional.thy
  11.200 +   "(.~ (REX x. F(x))) .= (RALL x. .~ F(x))"
  11.201 +   (fn _ => [rtac intI 1,
  11.202 +	     rewrite_goals_tac intensional_rews,
  11.203 +	     fast_tac HOL_cs 1
  11.204 +	    ]);
  11.205 +
  11.206 +(* IntLemmas.ML contains a collection of further lemmas about "intensional" logic.
  11.207 +   These are not loaded by default because they are not required for the
  11.208 +   standard proof procedures that first unlift proof goals to the HOL level.
  11.209 +
  11.210 +use "IntLemmas.ML";
  11.211 +
  11.212 +*)
    12.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    12.2 +++ b/src/HOL/TLA/Intensional.thy	Wed Oct 08 11:50:33 1997 +0200
    12.3 @@ -0,0 +1,101 @@
    12.4 +(* 
    12.5 +    File:	 TLA/Intensional.thy
    12.6 +    Author:      Stephan Merz
    12.7 +    Copyright:   1997 University of Munich
    12.8 +
    12.9 +    Theory Name: Intensional
   12.10 +    Logic Image: HOL
   12.11 +
   12.12 +Define a framework for "intensional" (possible-world based) logics
   12.13 +on top of HOL, with lifting of constants and functions.
   12.14 +*)
   12.15 +
   12.16 +Intensional  =  Prod +
   12.17 +
   12.18 +classes
   12.19 +    world < logic    (* Type class of "possible worlds". Concrete types
   12.20 +                        will be provided by children theories. *)
   12.21 +
   12.22 +types
   12.23 +    ('a,'w) term = "'w => 'a"    (* Intention: 'w::world *)
   12.24 +    'w form = "'w => bool"
   12.25 +
   12.26 +consts
   12.27 +  TrueInt  :: "('w::world form) => prop"             ("(_)" 5)
   12.28 +
   12.29 +  (* Holds at *)
   12.30 +  holdsAt  :: "['w::world, 'w form] => bool"   ("(_ |= _)" [100,9] 8)
   12.31 +
   12.32 +  (* Lifting base functions to "intensional" level *)
   12.33 +  con      :: "'a => ('w::world => 'a)"               ("(#_)" [100] 99)
   12.34 +  lift     :: "['a => 'b, 'w::world => 'a] => ('w => 'b)"  ("(_[_])")
   12.35 +  lift2    :: "['a => ('b => 'c), 'w::world => 'a, 'w => 'b] => ('w => 'c)" ("(_[_,/ _])")
   12.36 +  lift3    :: "['a => 'b => 'c => 'd, 'w::world => 'a, 'w => 'b, 'w => 'c] => ('w => 'd)" ("(_[_,/ _,/ _])")
   12.37 +
   12.38 +  (* Lifted infix functions *)
   12.39 +  IntEqu   :: "['w::world => 'a, 'w => 'a] => 'w form"  ("(_ .=/ _)" [50,51] 50)
   12.40 +  IntNeq   :: "['w::world => 'a, 'w => 'a] => 'w form"  ("(_ .~=/ _)" [50,51] 50)
   12.41 +  NotInt   :: "('w::world) form => 'w form"               ("(.~ _)" [40] 40)
   12.42 +  AndInt   :: "[('w::world) form, 'w form] => 'w form"    ("(_ .&/ _)" [36,35] 35)
   12.43 +  OrInt    :: "[('w::world) form, 'w form] => 'w form"    ("(_ .|/ _)" [31,30] 30)
   12.44 +  ImpInt   :: "[('w::world) form, 'w form] => 'w form"    ("(_ .->/ _)" [26,25] 25)
   12.45 +  IfInt    :: "[('w::world) form, ('a,'w) term, ('a,'w) term] => ('a,'w) term" ("(.if (_)/ .then (_)/ .else (_))" 10)
   12.46 +  PlusInt  :: "[('w::world) => ('a::plus), 'w => 'a] => ('w => 'a)"  ("(_ .+/ _)" [66,65] 65)
   12.47 +  MinusInt :: "[('w::world) => ('a::minus), 'w => 'a] => ('w => 'a)"  ("(_ .-/ _)" [66,65] 65)
   12.48 +  TimesInt :: "[('w::world) => ('a::times), 'w => 'a] => ('w => 'a)"  ("(_ .*/ _)" [71,70] 70)
   12.49 +
   12.50 +  LessInt  :: "['w::world => 'a::ord, 'w => 'a] => 'w form"        ("(_/ .< _)"  [50, 51] 50)
   12.51 +  LeqInt   :: "['w::world => 'a::ord, 'w => 'a] => 'w form"        ("(_/ .<= _)" [50, 51] 50)
   12.52 +
   12.53 +  (* lifted set membership *)
   12.54 +  memInt   :: "[('a,'w::world) term, ('a set,'w) term] => 'w form"  ("(_/ .: _)" [50, 51] 50)
   12.55 +
   12.56 +  (* "Rigid" quantification *)
   12.57 +  RAll     :: "('a => 'w::world form) => 'w form"     (binder "RALL " 10)
   12.58 +  REx      :: "('a => 'w::world form) => 'w form"     (binder "REX " 10)
   12.59 +
   12.60 +syntax
   12.61 +  "@tupleInt"    :: "args => ('a * 'b, 'w) term"  ("(1{[_]})")
   12.62 +
   12.63 +translations
   12.64 +
   12.65 +  "{[x,y,z]}"   == "{[x, {[y,z]} ]}"
   12.66 +  "{[x,y]}"     == "Pair [x, y]"
   12.67 +  "{[x]}"       => "x"
   12.68 +
   12.69 +  "u .= v" == "op =[u,v]"
   12.70 +  "u .~= v" == ".~(u .= v)"
   12.71 +  ".~ A"   == "Not[A]"
   12.72 +  "A .& B" == "op &[A,B]"
   12.73 +  "A .| B"  == "op |[A,B]"
   12.74 +  "A .-> B" == "op -->[A,B]"
   12.75 +  ".if A .then u .else v" == "If[A,u,v]"
   12.76 +  "u .+ v"  == "op +[u,v]"
   12.77 +  "u .- v" == "op -[u,v]"
   12.78 +  "u .* v" == "op *[u,v]"
   12.79 +
   12.80 +  "a .< b"  == "op < [a,b]"
   12.81 +  "a .<= b" == "op <= [a,b]"
   12.82 +  "a .: A"  == "op :[a,A]"
   12.83 +
   12.84 +  "holdsAt w (lift f x)"      == "lift f x w"
   12.85 +  "holdsAt w (lift2 f x y)"   == "lift2 f x y w"
   12.86 +  "holdsAt w (lift3 f x y z)" == "lift3 f x y z w"
   12.87 +
   12.88 +  "w |= A"              => "A(w)"
   12.89 +
   12.90 +rules
   12.91 +  inteq_reflection   "(x .= y) ==> (x == y)"
   12.92 +
   12.93 +  int_valid   "TrueInt(A) == (!! w. w |= A)"
   12.94 +
   12.95 +  unl_con     "(#c) w == c"             (* constants *)
   12.96 +  unl_lift    "(f[x]) w == f(x w)"
   12.97 +  unl_lift2   "(f[x,y]) w == f (x w) (y w)"
   12.98 +  unl_lift3   "(f[x, y, z]) w == f (x w) (y w) (z w)"
   12.99 +
  12.100 +  unl_Rall    "(RALL x. A(x)) w == ALL x. (w |= A(x))"
  12.101 +  unl_Rex     "(REX x. A(x)) w == EX x. (w |= A(x))"
  12.102 +end
  12.103 +
  12.104 +ML
    13.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    13.2 +++ b/src/HOL/TLA/Memory/MIParameters.thy	Wed Oct 08 11:50:33 1997 +0200
    13.3 @@ -0,0 +1,17 @@
    13.4 +(*
    13.5 +    File:        MIParameters.thy
    13.6 +    Author:      Stephan Merz
    13.7 +    Copyright:   1997 University of Munich
    13.8 +
    13.9 +    Theory Name: MIParameters
   13.10 +    Logic Image: TLA
   13.11 +
   13.12 +    RPC-Memory example: Parameters of the memory implementation.
   13.13 +*)
   13.14 +
   13.15 +MIParameters = Arith +
   13.16 +
   13.17 +datatype  histState  =  histA | histB
   13.18 +
   13.19 +end
   13.20 +
    14.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    14.2 +++ b/src/HOL/TLA/Memory/MIlive.ML	Wed Oct 08 11:50:33 1997 +0200
    14.3 @@ -0,0 +1,382 @@
    14.4 +(* 
    14.5 +    File:        MIlive.ML
    14.6 +    Author:      Stephan Merz
    14.7 +    Copyright:   1997 University of Munich
    14.8 +
    14.9 +    RPC-Memory example: Lower-level lemmas for the liveness proof
   14.10 +*)
   14.11 +
   14.12 +(* Liveness assertions for the different implementation states, based on the
   14.13 +   fairness conditions. Prove subgoals of WF1 / SF1 rules as separate lemmas
   14.14 +   for readability. Reuse action proofs from safety part.
   14.15 +*)
   14.16 +
   14.17 +(* ------------------------------ State S1 ------------------------------ *)
   14.18 +
   14.19 +qed_goal "S1_successors" MemoryImplementation.thy
   14.20 +   "$(S1 rmhist p) .& ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>  \
   14.21 +\   .-> $(S1 rmhist p)` .| $(S2 rmhist p)`"
   14.22 +   (fn _ => [split_idle_tac [] 1,
   14.23 +	     auto_tac (MI_css addSEs2 [action_conjimpE Step1_2_1])
   14.24 +	    ]);
   14.25 +
   14.26 +(* Show that the implementation can satisfy the high-level fairness requirements
   14.27 +   by entering the state S1 infinitely often.
   14.28 +*)
   14.29 +
   14.30 +qed_goal "S1_RNextdisabled" MemoryImplementation.thy
   14.31 +   "$(S1 rmhist p) .-> \
   14.32 +\   .~$(Enabled (<RNext memCh mem (resbar rmhist) p>_<rtrner memCh @ p, resbar rmhist @ p>))"
   14.33 +   (fn _ => [action_simp_tac (!simpset addsimps [angle_def,S_def,S1_def])
   14.34 +	                     [notI] [enabledE,MemoryidleE] 1,
   14.35 +	     auto_tac MI_fast_css
   14.36 +	    ]);
   14.37 +
   14.38 +qed_goal "S1_Returndisabled" MemoryImplementation.thy
   14.39 +   "$(S1 rmhist p) .-> \
   14.40 +\   .~$(Enabled (<MemReturn memCh (resbar rmhist) p>_<rtrner memCh @ p, resbar rmhist @ p>))"
   14.41 +   (fn _ => [action_simp_tac (!simpset addsimps [angle_def,MemReturn_def,Return_def,S_def,S1_def])
   14.42 +	                     [notI] [enabledE] 1
   14.43 +	    ]);
   14.44 +
   14.45 +qed_goal "RNext_fair" MemoryImplementation.thy
   14.46 +   "!!sigma. (sigma |= []<>($(S1 rmhist p)))   \
   14.47 +\     ==> (sigma |= WF(RNext memCh mem (resbar rmhist) p)_<rtrner memCh @ p, resbar rmhist @ p>)"
   14.48 +   (fn _ => [auto_tac (MI_css addsimps2 [temp_rewrite WF_alt]
   14.49 +			      addSIs2 [S1_RNextdisabled] addSEs2 [STL4E,DmdImplE])
   14.50 +	    ]);
   14.51 +
   14.52 +qed_goal "Return_fair" MemoryImplementation.thy
   14.53 +   "!!sigma. (sigma |= []<>($(S1 rmhist p)))   \
   14.54 +\     ==> (sigma |= WF(MemReturn memCh (resbar rmhist) p)_<rtrner memCh @ p, resbar rmhist @ p>)"
   14.55 +   (fn _ => [auto_tac (MI_css addsimps2 [temp_rewrite WF_alt]
   14.56 +			      addSIs2 [S1_Returndisabled] addSEs2 [STL4E,DmdImplE])
   14.57 +	    ]);
   14.58 +
   14.59 +(* ------------------------------ State S2 ------------------------------ *)
   14.60 +
   14.61 +qed_goal "S2_successors" MemoryImplementation.thy
   14.62 +   "$(S2 rmhist p) .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>)   \
   14.63 +\   .-> $(S2 rmhist p)` .| $(S3 rmhist p)`"
   14.64 +   (fn _ => [split_idle_tac [] 1,
   14.65 +	     auto_tac (MI_css addSEs2 [action_conjimpE Step1_2_2])
   14.66 +	    ]);
   14.67 +
   14.68 +qed_goal "S2MClkFwd_successors" MemoryImplementation.thy
   14.69 +   "$(S2 rmhist p) .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>)    \
   14.70 +\                  .& <MClkFwd memCh crCh cst p>_(c p) \
   14.71 +\   .-> $(S3 rmhist p)`"
   14.72 +   (fn _ => [ auto_tac (MI_css addsimps2 [angle_def] addSEs2 [action_conjimpE Step1_2_2]) ]);
   14.73 +
   14.74 +qed_goal "S2MClkFwd_enabled" MemoryImplementation.thy
   14.75 +   "$(S2 rmhist p) .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>)   \
   14.76 +\   .-> $(Enabled (<MClkFwd memCh crCh cst p>_(c p)))"
   14.77 +   (fn _ => [cut_facts_tac [MI_base] 1,
   14.78 +	     auto_tac (MI_css addsimps2 [c_def,base_pair]
   14.79 +		              addSIs2 [MClkFwd_ch_enabled,action_mp MClkFwd_enabled]),
   14.80 +	     ALLGOALS (action_simp_tac (!simpset addsimps [S_def,S2_def]) [] [])
   14.81 +	    ]);
   14.82 +
   14.83 +qed_goal "S2_live" MemoryImplementation.thy
   14.84 +   "[](ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>) .& WF(MClkFwd memCh crCh cst p)_(c p) \
   14.85 +\   .-> ($(S2 rmhist p) ~> $(S3 rmhist p))"
   14.86 +   (fn _ => [REPEAT (resolve_tac [WF1,S2_successors,
   14.87 +				  S2MClkFwd_successors,S2MClkFwd_enabled] 1)
   14.88 +	    ]);
   14.89 +
   14.90 +
   14.91 +(* ------------------------------ State S3 ------------------------------ *)
   14.92 +
   14.93 +qed_goal "S3_successors" MemoryImplementation.thy
   14.94 +   "$(S3 rmhist p) .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>)   \
   14.95 +\   .-> $(S3 rmhist p)` .| ($(S4 rmhist p) .| $(S6 rmhist p))`"
   14.96 +   (fn _ => [split_idle_tac [] 1,
   14.97 +	     auto_tac (MI_css addSEs2 [action_conjimpE Step1_2_3])
   14.98 +	    ]);
   14.99 +
  14.100 +qed_goal "S3RPC_successors" MemoryImplementation.thy
  14.101 +   "$(S3 rmhist p) .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>)   \
  14.102 +\                  .& <RPCNext crCh rmCh rst p>_(r p) \
  14.103 +\   .-> ($(S4 rmhist p) .| $(S6 rmhist p))`"
  14.104 +   (fn _ => [ auto_tac (MI_css addsimps2 [angle_def] addSEs2 [action_conjimpE Step1_2_3]) ]);
  14.105 +
  14.106 +qed_goal "S3RPC_enabled" MemoryImplementation.thy
  14.107 +   "$(S3 rmhist p) .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>)   \
  14.108 +\   .-> $(Enabled (<RPCNext crCh rmCh rst p>_(r p)))"
  14.109 +   (fn _ => [cut_facts_tac [MI_base] 1,
  14.110 +	     auto_tac (MI_css addsimps2 [r_def,base_pair]
  14.111 +		              addSIs2 [RPCFail_Next_enabled,action_mp RPCFail_enabled]),
  14.112 +	     ALLGOALS (action_simp_tac (!simpset addsimps [S_def,S3_def]) [] [])
  14.113 +	    ]);
  14.114 +
  14.115 +qed_goal "S3_live" MemoryImplementation.thy
  14.116 +   "[](ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>)  \
  14.117 +\        .& WF(RPCNext crCh rmCh rst p)_(r p) \
  14.118 +\   .-> ($(S3 rmhist p) ~> ($(S4 rmhist p) .| $(S6 rmhist p)))"
  14.119 +   (fn _ => [REPEAT (resolve_tac [WF1,S3_successors,S3RPC_successors,S3RPC_enabled] 1)]);
  14.120 +
  14.121 +(* ------------- State S4 -------------------------------------------------- *)
  14.122 +
  14.123 +qed_goal "S4_successors" MemoryImplementation.thy
  14.124 +   "$(S4 rmhist p) .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p> \
  14.125 +\                                .& (RALL l. $(MemInv mem l)))  \
  14.126 +\   .-> $(S4 rmhist p)` .| $(S5 rmhist p)`"
  14.127 +   (fn _ => [split_idle_tac [] 1,
  14.128 +	     auto_tac (MI_css addSEs2 [action_conjimpE Step1_2_4])
  14.129 +	    ]);
  14.130 +
  14.131 +(* ------------- State S4a: S4 /\ (ires p = NotAResult) ------------------------------ *)
  14.132 +
  14.133 +qed_goal "S4a_successors" MemoryImplementation.thy
  14.134 +   "($(S4 rmhist p) .& ($(ires@p) .= #NotAResult)) \
  14.135 +\                   .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p> \
  14.136 +\                                 .& (RALL l. $(MemInv mem l))) \
  14.137 +\   .-> ($(S4 rmhist p) .& ($(ires@p) .= #NotAResult))`  \
  14.138 +\       .| (($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) .| $(S5 rmhist p))`"
  14.139 +   (fn _ => [split_idle_tac [m_def] 1,
  14.140 +	     auto_tac (MI_css addsimps2 [m_def] addSEs2 [action_conjimpE Step1_2_4])
  14.141 +	    ]);
  14.142 +
  14.143 +qed_goal "S4aRNext_successors" MemoryImplementation.thy
  14.144 +   "($(S4 rmhist p) .& ($(ires@p) .= #NotAResult))  \
  14.145 +\   .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>   \
  14.146 +\                 .& (RALL l. $(MemInv mem l)))  \
  14.147 +\   .& <RNext rmCh mem ires p>_(m p) \
  14.148 +\   .-> (($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) .| $(S5 rmhist p))`"
  14.149 +   (fn _ => [auto_tac (MI_css addsimps2 [angle_def]
  14.150 +		              addSEs2 [action_conjimpE Step1_2_4,
  14.151 +				       action_conjimpE ReadResult, action_impE WriteResult])
  14.152 +	    ]);
  14.153 +
  14.154 +qed_goal "S4aRNext_enabled" MemoryImplementation.thy
  14.155 +   "($(S4 rmhist p) .& ($(ires@p) .= #NotAResult)) \
  14.156 +\   .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>   \
  14.157 +\                 .& (RALL l. $(MemInv mem l)))  \
  14.158 +\   .-> $(Enabled (<RNext rmCh mem ires p>_(m p)))"
  14.159 +   (fn _ => [auto_tac (MI_css addsimps2 [m_def] addSIs2 [action_mp RNext_enabled]),
  14.160 +	     ALLGOALS (cut_facts_tac [MI_base]),
  14.161 +	     auto_tac (MI_css addsimps2 [base_pair]),
  14.162 +	        (* it's faster to expand S4 only where necessary *)
  14.163 +	     action_simp_tac (!simpset addsimps [S_def,S4_def]) [] [] 1
  14.164 +	    ]);
  14.165 +
  14.166 +qed_goal "S4a_live" MemoryImplementation.thy
  14.167 +  "[](ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p> .& (RALL l. $(MemInv mem l))) \
  14.168 +\  .& WF(RNext rmCh mem ires p)_(m p) \
  14.169 +\  .-> (($(S4 rmhist p) .& ($(ires@p) .= #NotAResult))  \
  14.170 +\        ~> ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) .| $(S5 rmhist p))"
  14.171 +   (fn _ => [rtac WF1 1,
  14.172 +	     ALLGOALS (action_simp_tac (!simpset)
  14.173 +		                       (map ((rewrite_rule [slice_def]) o action_mp) 
  14.174 +                                            [S4a_successors,S4aRNext_successors,S4aRNext_enabled])
  14.175 +				       [])
  14.176 +	    ]);
  14.177 +
  14.178 +(* ------------- State S4b: S4 /\ (ires p # NotAResult) ------------------------------ *)
  14.179 +
  14.180 +qed_goal "S4b_successors" MemoryImplementation.thy
  14.181 +   "($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult))  \
  14.182 +\                   .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p> \
  14.183 +\                                 .& (RALL l. $(MemInv mem l))) \
  14.184 +\   .-> ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult))` .| $(S5 rmhist p)`"
  14.185 +   (fn _ => [split_idle_tac [m_def] 1,
  14.186 +	     auto_tac (MI_css addSEs2 (action_impE WriteResult
  14.187 +				       :: map action_conjimpE [Step1_2_4,ReadResult]))
  14.188 +	    ]);
  14.189 +
  14.190 +qed_goal "S4bReturn_successors" MemoryImplementation.thy
  14.191 +   "($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult))  \
  14.192 +\   .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p> \
  14.193 +\                 .& (RALL l. $(MemInv mem l)))   \
  14.194 +\   .& <MemReturn rmCh ires p>_(m p) \
  14.195 +\   .-> ($(S5 rmhist p))`"
  14.196 +   (fn _ => [auto_tac (MI_css addsimps2 [angle_def]
  14.197 +	                      addSEs2 [action_conjimpE Step1_2_4]
  14.198 +		              addEs2 [action_conjimpE ReturnNotReadWrite])
  14.199 +	    ]);
  14.200 +
  14.201 +qed_goal "S4bReturn_enabled" MemoryImplementation.thy
  14.202 +   "($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult))  \
  14.203 +\   .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p> \
  14.204 +\                 .& (RALL l. $(MemInv mem l)))  \
  14.205 +\   .-> $(Enabled (<MemReturn rmCh ires p>_(m p)))"
  14.206 +   (fn _ => [cut_facts_tac [MI_base] 1,
  14.207 +             auto_tac (MI_css addsimps2 [m_def,base_pair]
  14.208 +		              addSIs2 [action_mp MemReturn_enabled]),
  14.209 +	     ALLGOALS (action_simp_tac (!simpset addsimps [S_def,S4_def]) [] [])
  14.210 +	    ]);
  14.211 +
  14.212 +qed_goal "S4b_live" MemoryImplementation.thy
  14.213 +  "[](ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p> .& (RALL l. $(MemInv mem l))) \
  14.214 +\  .& WF(MemReturn rmCh ires p)_(m p) \
  14.215 +\  .-> (($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) ~> $(S5 rmhist p))"
  14.216 +   (fn _ => [rtac WF1 1,
  14.217 +	     ALLGOALS (action_simp_tac (!simpset)
  14.218 +		                       (map ((rewrite_rule [slice_def]) o action_mp) 
  14.219 +                                            [S4b_successors,S4bReturn_successors,S4bReturn_enabled])
  14.220 +				       [allE])
  14.221 +	    ]);
  14.222 +
  14.223 +(* ------------------------------ State S5 ------------------------------ *)
  14.224 +
  14.225 +qed_goal "S5_successors" MemoryImplementation.thy
  14.226 +   "$(S5 rmhist p) .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>) \
  14.227 +\   .-> $(S5 rmhist p)` .| $(S6 rmhist p)`"
  14.228 +   (fn _ => [split_idle_tac [] 1,
  14.229 +	     auto_tac (MI_css addSEs2 [action_conjimpE Step1_2_5])
  14.230 +	    ]);
  14.231 +
  14.232 +qed_goal "S5RPC_successors" MemoryImplementation.thy
  14.233 +   "$(S5 rmhist p) .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>) \
  14.234 +\   .& <RPCNext crCh rmCh rst p>_(r p) \
  14.235 +\   .-> $(S6 rmhist p)`"
  14.236 +   (fn _ => [ auto_tac (MI_css addsimps2 [angle_def] addSEs2 [action_conjimpE Step1_2_5]) ]);
  14.237 +
  14.238 +qed_goal "S5RPC_enabled" MemoryImplementation.thy
  14.239 +   "$(S5 rmhist p) .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>) \
  14.240 +\   .-> $(Enabled (<RPCNext crCh rmCh rst p>_(r p)))"
  14.241 +   (fn _ => [cut_facts_tac [MI_base] 1,
  14.242 +	     auto_tac (MI_css addsimps2 [r_def,base_pair]
  14.243 +		              addSIs2 [RPCFail_Next_enabled,action_mp RPCFail_enabled]),
  14.244 +	     ALLGOALS (action_simp_tac (!simpset addsimps [S_def,S5_def]) [] [])
  14.245 +	    ]);
  14.246 +
  14.247 +qed_goal "S5_live" MemoryImplementation.thy
  14.248 +   "[](ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>)   \
  14.249 +\   .& WF(RPCNext crCh rmCh rst p)_(r p) \
  14.250 +\   .-> ($(S5 rmhist p) ~> $(S6 rmhist p))"
  14.251 +   (fn _ => [REPEAT (resolve_tac [WF1,S5_successors,S5RPC_successors,S5RPC_enabled] 1)]);
  14.252 +
  14.253 +
  14.254 +(* ------------------------------ State S6 ------------------------------ *)
  14.255 +
  14.256 +qed_goal "S6_successors" MemoryImplementation.thy
  14.257 +   "$(S6 rmhist p) .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>) \
  14.258 +\   .-> $(S1 rmhist p)` .| $(S3 rmhist p)` .| $(S6 rmhist p)`"
  14.259 +   (fn _ => [split_idle_tac [] 1,
  14.260 +	     auto_tac (MI_css addSEs2 [action_conjimpE Step1_2_6])
  14.261 +	    ]);
  14.262 +
  14.263 +qed_goal "S6MClkReply_successors" MemoryImplementation.thy
  14.264 +   "$(S6 rmhist p) .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>) \
  14.265 +\   .& <MClkReply memCh crCh cst p>_(c p) \
  14.266 +\   .-> $(S1 rmhist p)`"
  14.267 +   (fn _ => [auto_tac (MI_css addsimps2 [angle_def] addSEs2 [action_conjimpE Step1_2_6,
  14.268 +							     action_impE MClkReplyNotRetry])
  14.269 +	    ]);
  14.270 +
  14.271 +qed_goal "MClkReplyS6" MemoryImplementation.thy
  14.272 +   "$(ImpInv rmhist p) .& <MClkReply memCh crCh cst p>_(c p) .-> $(S6 rmhist p)"
  14.273 +   (fn _ => [action_simp_tac
  14.274 +	        (!simpset addsimps
  14.275 +		    [angle_def,MClkReply_def,Return_def,
  14.276 +		     ImpInv_def,S_def,S1_def,S2_def,S3_def,S4_def,S5_def])
  14.277 +		[] [] 1
  14.278 +	    ]);
  14.279 +
  14.280 +qed_goal "S6MClkReply_enabled" MemoryImplementation.thy
  14.281 +   "$(S6 rmhist p) .-> $(Enabled (<MClkReply memCh crCh cst p>_(c p)))"
  14.282 +   (fn _ => [cut_facts_tac [MI_base] 1,
  14.283 +	     auto_tac (MI_css addsimps2 [c_def,base_pair]
  14.284 +		              addSIs2 [action_mp MClkReply_enabled]),
  14.285 +	     ALLGOALS (action_simp_tac (!simpset addsimps [S_def,S6_def]) [] [])
  14.286 +	    ]);
  14.287 +
  14.288 +qed_goal "S6_live" MemoryImplementation.thy
  14.289 +   "[](ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p> .& $(ImpInv rmhist p)) \
  14.290 +\   .& SF(MClkReply memCh crCh cst p)_(c p) .& []<>($(S6 rmhist p))  \
  14.291 +\   .-> []<>($(S1 rmhist p))"
  14.292 +   (fn _ => [Auto_tac(),
  14.293 +	     subgoal_tac "sigma |= []<>(<MClkReply memCh crCh cst p>_(c p))" 1,
  14.294 +	     eres_inst_tac [("P","<MClkReply memCh crCh cst p>_(c p)")]
  14.295 +	                   EnsuresInfinite 1, atac 1,
  14.296 +	     action_simp_tac (!simpset) []
  14.297 +	                     (map action_conjimpE [MClkReplyS6,S6MClkReply_successors]) 1,
  14.298 +	     auto_tac (MI_css addsimps2 [SF_def]),
  14.299 +	     etac swap 1,
  14.300 +	     auto_tac (MI_css addSIs2 [action_mp S6MClkReply_enabled]
  14.301 +		              addSEs2 [STL4E,DmdImplE])
  14.302 +	    ]);
  14.303 +
  14.304 +(* ------------------------------ complex leadsto properties ------------------------------ *)
  14.305 +
  14.306 +qed_goal "S5S6LeadstoS6" MemoryImplementation.thy
  14.307 +   "!!sigma. (sigma |= $(S5 rmhist p) ~> $(S6 rmhist p)) \
  14.308 +\      ==> (sigma |= ($(S5 rmhist p) .| $(S6 rmhist p)) ~> $(S6 rmhist p))"
  14.309 +   (fn _ => [auto_tac (MI_css addSIs2 [LatticeDisjunctionIntro,
  14.310 +				       temp_unlift LatticeReflexivity])
  14.311 +	    ]);
  14.312 +
  14.313 +qed_goal "S4bS5S6LeadstoS6" MemoryImplementation.thy
  14.314 +   "!!sigma. [| (sigma |= ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) ~> $(S5 rmhist p));  \
  14.315 +\               (sigma |= $(S5 rmhist p) ~> $(S6 rmhist p)) |]  \
  14.316 +\      ==> (sigma |= (($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) .| $(S5 rmhist p) .| $(S6 rmhist p)) ~> $(S6 rmhist p))"
  14.317 +   (fn _ => [auto_tac (MI_css addSIs2 [LatticeDisjunctionIntro,S5S6LeadstoS6]
  14.318 +		              addIs2 [LatticeTransitivity])
  14.319 +            ]);
  14.320 +
  14.321 +qed_goal "S4S5S6LeadstoS6" MemoryImplementation.thy
  14.322 +   "!!sigma. [| (sigma |= ($(S4 rmhist p) .& ($(ires@p) .= #NotAResult)) \
  14.323 +\                             ~> ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) .| $(S5 rmhist p)); \
  14.324 +\               (sigma |= ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) ~> $(S5 rmhist p));  \
  14.325 +\               (sigma |= $(S5 rmhist p) ~> $(S6 rmhist p)) |]  \
  14.326 +\      ==> (sigma |= ($(S4 rmhist p) .| $(S5 rmhist p) .| $(S6 rmhist p)) ~> $(S6 rmhist p))"
  14.327 +   (fn _ => [subgoal_tac "sigma |= (($(S4 rmhist p) .& ($(ires@p) .= #NotAResult)) .| ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) .| $(S5 rmhist p) .| $(S6 rmhist p)) ~> $(S6 rmhist p)" 1,
  14.328 +	     eres_inst_tac [("G", "($(S4 rmhist p) .& ($(ires@p) .= #NotAResult)) .| ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) .| $(S5 rmhist p) .| $(S6 rmhist p)")] LatticeTransitivity 1,
  14.329 +	     SELECT_GOAL (auto_tac (MI_css addSIs2 [ImplLeadsto, temp_unlift necT])) 1,
  14.330 +	     rtac LatticeDisjunctionIntro 1,
  14.331 +	     etac LatticeTransitivity 1,
  14.332 +	     etac LatticeTriangle 1, atac 1,
  14.333 +	     auto_tac (MI_css addSIs2 [S4bS5S6LeadstoS6])
  14.334 +	    ]);
  14.335 +
  14.336 +qed_goal "S3S4S5S6LeadstoS6" MemoryImplementation.thy
  14.337 +   "!!sigma. [| (sigma |= $(S3 rmhist p) ~> ($(S4 rmhist p) .| $(S6 rmhist p)));   \
  14.338 +\               (sigma |= ($(S4 rmhist p) .& ($(ires@p) .= #NotAResult)) \
  14.339 +\                         ~> ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) .| $(S5 rmhist p)); \
  14.340 +\               (sigma |= ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) ~> $(S5 rmhist p));  \
  14.341 +\               (sigma |= $(S5 rmhist p) ~> $(S6 rmhist p)) |]  \
  14.342 +\      ==> (sigma |= ($(S3 rmhist p) .| $(S4 rmhist p) .| $(S5 rmhist p) .| $(S6 rmhist p)) ~> $(S6 rmhist p))"
  14.343 +   (fn _ => [rtac LatticeDisjunctionIntro 1,
  14.344 +	     rtac LatticeTriangle 1, atac 2,
  14.345 +	     rtac (S4S5S6LeadstoS6 RS LatticeTransitivity) 1,
  14.346 +	     auto_tac (MI_css addSIs2 [S4S5S6LeadstoS6,temp_unlift necT]
  14.347 +			      addIs2 [ImplLeadsto])
  14.348 +	    ]);
  14.349 +
  14.350 +qed_goal "S2S3S4S5S6LeadstoS6" MemoryImplementation.thy
  14.351 +   "!!sigma. [| (sigma |= $(S2 rmhist p) ~> $(S3 rmhist p)); \
  14.352 +\               (sigma |= $(S3 rmhist p) ~> ($(S4 rmhist p) .| $(S6 rmhist p)));   \
  14.353 +\               (sigma |= ($(S4 rmhist p) .& ($(ires@p) .= #NotAResult)) \
  14.354 +\                         ~> ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) .| $(S5 rmhist p)); \
  14.355 +\               (sigma |= ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) ~> $(S5 rmhist p));  \
  14.356 +\               (sigma |= $(S5 rmhist p) ~> $(S6 rmhist p)) |]  \
  14.357 +\      ==> (sigma |= ($(S2 rmhist p) .| $(S3 rmhist p) .| $(S4 rmhist p) .| $(S5 rmhist p) .| $(S6 rmhist p)) ~> $(S6 rmhist p))"
  14.358 +   (fn _ => [rtac LatticeDisjunctionIntro 1,
  14.359 +	     rtac LatticeTransitivity 1, atac 2,
  14.360 +	     rtac (S3S4S5S6LeadstoS6 RS LatticeTransitivity) 1,
  14.361 +	     auto_tac (MI_css addSIs2 [S3S4S5S6LeadstoS6,temp_unlift necT]
  14.362 +			      addIs2 [ImplLeadsto])
  14.363 +	    ]);
  14.364 +
  14.365 +qed_goal "NotS1LeadstoS6" MemoryImplementation.thy
  14.366 +   "!!sigma. [| (sigma |= []($(ImpInv rmhist p))); \
  14.367 +\        (sigma |= $(S2 rmhist p) ~> $(S3 rmhist p)); \
  14.368 +\        (sigma |= $(S3 rmhist p) ~> ($(S4 rmhist p) .| $(S6 rmhist p))); \
  14.369 +\        (sigma |= ($(S4 rmhist p) .& ($(ires@p) .= #NotAResult)) \
  14.370 +\                  ~> ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) .| $(S5 rmhist p)); \
  14.371 +\        (sigma |= ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) ~> $(S5 rmhist p));  \
  14.372 +\        (sigma |= $(S5 rmhist p) ~> $(S6 rmhist p)) |] \
  14.373 +\        ==> (sigma |= .~$(S1 rmhist p) ~> $(S6 rmhist p))"
  14.374 +   (fn _ => [rtac (S2S3S4S5S6LeadstoS6 RS LatticeTransitivity) 1,
  14.375 +	     auto_tac (MI_css addsimps2 [ImpInv_def] addIs2 [ImplLeadsto] addSEs2 [STL4E])
  14.376 +	    ]);
  14.377 +
  14.378 +qed_goal "S1Infinite" MemoryImplementation.thy
  14.379 +   "!!sigma. [| (sigma |= .~$(S1 rmhist p) ~> $(S6 rmhist p)); \
  14.380 +\               (sigma |= []<>($(S6 rmhist p)) .-> []<>($(S1 rmhist p))) |] \
  14.381 +\            ==> (sigma |= []<>($(S1 rmhist p)))"
  14.382 +   (fn _ => [rtac classical 1,
  14.383 +	     asm_full_simp_tac (!simpset addsimps [NotBox, temp_rewrite NotDmd]) 1,
  14.384 +	     auto_tac (MI_css addSEs2 [mp,leadsto_infinite] addSDs2 [temp_mp DBImplBDAct])
  14.385 +	    ]);
    15.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    15.2 +++ b/src/HOL/TLA/Memory/MIsafe.ML	Wed Oct 08 11:50:33 1997 +0200
    15.3 @@ -0,0 +1,449 @@
    15.4 +(* 
    15.5 +    File:        MIsafe.ML
    15.6 +    Author:      Stephan Merz
    15.7 +    Copyright:   1997 University of Munich
    15.8 +
    15.9 +    RPC-Memory example: Lower-level lemmas about memory implementation (safety)
   15.10 +*)
   15.11 +
   15.12 +(* ========================= Lemmas about values ========================= *)
   15.13 +
   15.14 +(* RPCFailure notin MemVals U {OK,BadArg} *)
   15.15 +
   15.16 +qed_goal "MVOKBAnotRF" MemoryImplementation.thy
   15.17 +   "!!x. MVOKBA x ==> x ~= RPCFailure"
   15.18 +   (fn _ => [ auto_tac (HOL_css addsimps2 (RP_simps @ [MVOKBA_def])) ]);
   15.19 +bind_thm("MVOKBAnotRFE", make_elim MVOKBAnotRF);
   15.20 +
   15.21 +(* NotAResult notin MemVals U {OK,BadArg,RPCFailure} *)
   15.22 +
   15.23 +qed_goal "MVOKBARFnotNR" MemoryImplementation.thy
   15.24 +   "!!x. MVOKBARF x ==> x ~= NotAResult"
   15.25 +   (fn _ => [ auto_tac (HOL_css addsimps2 (RP_simps @ [MVOKBARF_def])
   15.26 +			        addSEs2 [MemValNotAResultE])
   15.27 +	    ]);
   15.28 +bind_thm("MVOKBARFnotNRE", make_elim MVOKBARFnotNR);
   15.29 +
   15.30 +(* ========================= Si's are mutually exclusive ==================================== *)
   15.31 +(* Si and Sj are mutually exclusive for i # j. This helps to simplify the big
   15.32 +   conditional in the definition of resbar when doing the step-simulation proof.
   15.33 +   We prove a weaker result, which suffices for our purposes: 
   15.34 +   Si implies (not Sj), for j<i.
   15.35 +*)
   15.36 +
   15.37 +(* --- not used ---
   15.38 +qed_goal "S1_excl" MemoryImplementation.thy 
   15.39 +     "$(S1 rmhist p) .-> $(S1 rmhist p) .& .~$(S2 rmhist p) .& .~$(S3 rmhist p) .& \
   15.40 +\                        .~$(S4 rmhist p) .& .~$(S5 rmhist p) .& .~$(S6 rmhist p)"
   15.41 +   (fn _ => [ auto_tac (MI_css addsimps2 [S_def, S1_def, S2_def,
   15.42 +                                          S3_def, S4_def, S5_def, S6_def])
   15.43 +            ]);
   15.44 +*)
   15.45 +
   15.46 +qed_goal "S2_excl" MemoryImplementation.thy 
   15.47 +     "$(S2 rmhist p) .-> $(S2 rmhist p) .& .~$(S1 rmhist p)"
   15.48 +   (fn _ => [ auto_tac (MI_css addsimps2 [S_def, S1_def, S2_def]) ]);
   15.49 +bind_thm("S2_exclE", action_impE S2_excl);
   15.50 +
   15.51 +qed_goal "S3_excl" MemoryImplementation.thy 
   15.52 +     "$(S3 rmhist p) .-> $(S3 rmhist p) .& .~$(S1 rmhist p) .& .~$(S2 rmhist p)"
   15.53 +   (fn _ => [ auto_tac (MI_css addsimps2 [S_def, S1_def, S2_def, S3_def]) ]);
   15.54 +bind_thm("S3_exclE", action_impE S3_excl);
   15.55 +
   15.56 +qed_goal "S4_excl" MemoryImplementation.thy 
   15.57 +     "$(S4 rmhist p) .-> $(S4 rmhist p) .& .~$(S1 rmhist p) .& .~$(S2 rmhist p) .& .~$(S3 rmhist p)"
   15.58 +   (fn _ => [ auto_tac (MI_css addsimps2 [S_def,S1_def,S2_def,S3_def,S4_def]) ]);
   15.59 +bind_thm("S4_exclE", action_impE S4_excl);
   15.60 +
   15.61 +qed_goal "S5_excl" MemoryImplementation.thy 
   15.62 +     "$(S5 rmhist p) .-> $(S5 rmhist p) .& .~$(S1 rmhist p) .& .~$(S2 rmhist p) .& \
   15.63 +\                        .~$(S3 rmhist p) .& .~$(S4 rmhist p)"
   15.64 +   (fn _ => [ auto_tac (MI_css addsimps2 [S_def,S1_def,S2_def,S3_def,S4_def,S5_def]) ]);
   15.65 +bind_thm("S5_exclE", action_impE S5_excl);
   15.66 +
   15.67 +qed_goal "S6_excl" MemoryImplementation.thy 
   15.68 +     "$(S6 rmhist p) .-> $(S6 rmhist p) .& .~$(S1 rmhist p) .& .~$(S2 rmhist p) .& \
   15.69 +\                        .~$(S3 rmhist p) .& .~$(S4 rmhist p) .& .~$(S5 rmhist p)"
   15.70 +   (fn _ => [ auto_tac (MI_css addsimps2 [S_def,S1_def,S2_def,S3_def,S4_def,S5_def,S6_def]) ]);
   15.71 +bind_thm("S6_exclE", action_impE S6_excl);
   15.72 +
   15.73 +
   15.74 +(* ==================== Lemmas about the environment ============================== *)
   15.75 +
   15.76 +qed_goal "Envbusy" MemoryImplementation.thy
   15.77 +   "$(Calling memCh p) .-> .~ ENext p"
   15.78 +   (fn _ => [ auto_tac (MI_css addsimps2 [ENext_def,Call_def]) ]);
   15.79 +
   15.80 +(* ==================== Lemmas about the implementation's states ==================== *)
   15.81 +
   15.82 +(* The following series of lemmas are used in establishing the implementation's
   15.83 +   next-state relation (Step 1.2 of the proof in the paper). For each state Si, we
   15.84 +   establish which component actions are possible and their results.
   15.85 +*)
   15.86 +
   15.87 +(* ------------------------------ State S1 ---------------------------------------- *) 
   15.88 +
   15.89 +qed_goal "S1Env" MemoryImplementation.thy
   15.90 +   "(ENext p) .& $(S1 rmhist p) .& unchanged <c p, r p, m p, rmhist@p> .-> (S2 rmhist p)$"
   15.91 +   (fn _ => [auto_tac (MI_css
   15.92 +		       addsimps2 [ENext_def,Call_def,c_def,r_def,m_def,
   15.93 +				  caller_def,rtrner_def,MVNROKBA_def,
   15.94 +                                  S_def,S1_def,S2_def,Calling_def])
   15.95 +	    ]);
   15.96 +bind_thm("S1EnvE", action_conjimpE S1Env);
   15.97 +
   15.98 +qed_goal "S1ClerkUnch" MemoryImplementation.thy 
   15.99 +   "[MClkNext memCh crCh cst p]_(c p) .& $(S1 rmhist p) .-> unchanged (c p)"
  15.100 +   (fn _ => [auto_tac (MI_fast_css addSEs2 [action_conjimpE MClkidle]
  15.101 +		                   addsimps2 [square_def,S_def,S1_def])
  15.102 +	    ]);
  15.103 +bind_thm("S1ClerkUnchE", action_conjimpE S1ClerkUnch);
  15.104 +
  15.105 +qed_goal "S1RPCUnch" MemoryImplementation.thy
  15.106 +   "[RPCNext crCh rmCh rst p]_(r p) .& $(S1 rmhist p) .-> unchanged (r p)"
  15.107 +   (fn _ => [auto_tac (MI_fast_css addSEs2 [action_impE RPCidle]
  15.108 +		                   addsimps2 [square_def,S_def,S1_def])
  15.109 +	    ]);
  15.110 +bind_thm("S1RPCUnchE", action_conjimpE S1RPCUnch);
  15.111 +
  15.112 +qed_goal "S1MemUnch" MemoryImplementation.thy
  15.113 +   "[RNext rmCh mem ires p]_(m p) .& $(S1 rmhist p) .-> unchanged (m p)"
  15.114 +   (fn _ => [auto_tac (MI_fast_css addSEs2 [action_impE Memoryidle]
  15.115 +		                   addsimps2 [square_def,S_def,S1_def])
  15.116 +	    ]);
  15.117 +bind_thm("S1MemUnchE", action_conjimpE S1MemUnch);
  15.118 +
  15.119 +qed_goal "S1Hist" MemoryImplementation.thy
  15.120 +   "[HNext rmhist p]_<c p,r p,m p,rmhist@p> .& $(S1 rmhist p) .-> unchanged (rmhist@p)"
  15.121 +   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,HNext_def,MemReturn_def,
  15.122 +					      RPCFail_def,MClkReply_def,Return_def,
  15.123 +		                              S_def,S1_def])
  15.124 +	    ]);
  15.125 +bind_thm("S1HistE", action_conjimpE S1Hist);
  15.126 +
  15.127 +(* ------------------------------ State S2 ---------------------------------------- *)
  15.128 +
  15.129 +qed_goal "S2EnvUnch" MemoryImplementation.thy
  15.130 +   "[ENext p]_(e p) .& $(S2 rmhist p) .-> unchanged (e p)"
  15.131 +   (fn _ => [auto_tac (MI_fast_css addSEs2 [action_impE Envbusy]
  15.132 +		                   addsimps2 [square_def,S_def,S2_def])
  15.133 +	    ]);
  15.134 +bind_thm("S2EnvUnchE", action_conjimpE S2EnvUnch);
  15.135 +
  15.136 +qed_goal "S2Clerk" MemoryImplementation.thy
  15.137 +   "MClkNext memCh crCh cst p .& $(S2 rmhist p) .-> MClkFwd memCh crCh cst p"
  15.138 +   (fn _ => [auto_tac (MI_fast_css addsimps2 [MClkNext_def,MClkRetry_def,MClkReply_def,
  15.139 +					      S_def,S2_def])
  15.140 +	    ]);
  15.141 +bind_thm("S2ClerkE", action_conjimpE S2Clerk);
  15.142 +
  15.143 +(* The dumb action_simp_tac wins 15 : 129 over auto_tac *)
  15.144 +qed_goal "S2Forward" MemoryImplementation.thy
  15.145 +   "$(S2 rmhist p) .& (MClkFwd memCh crCh cst p) .& unchanged <e p, r p, m p, rmhist@p> \
  15.146 +\   .-> (S3 rmhist p)$"
  15.147 +   (fn _ => [action_simp_tac (!simpset addsimps
  15.148 +                [MClkFwd_def,Call_def,e_def,r_def,m_def,caller_def,rtrner_def,
  15.149 +                 S_def,S2_def,S3_def,Calling_def])
  15.150 +               [] [] 1
  15.151 +	     ]);
  15.152 +bind_thm("S2ForwardE", action_conjimpE S2Forward);
  15.153 +
  15.154 +qed_goal "S2RPCUnch" MemoryImplementation.thy
  15.155 +   "[RPCNext crCh rmCh rst p]_(r p) .& $(S2 rmhist p) .-> unchanged (r p)"
  15.156 +   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,S_def,S2_def]
  15.157 +		                   addSEs2 [action_impE RPCidle])
  15.158 +	    ]);
  15.159 +bind_thm("S2RPCUnchE", action_conjimpE S2RPCUnch);
  15.160 +
  15.161 +qed_goal "S2MemUnch" MemoryImplementation.thy
  15.162 +   "[RNext rmCh mem ires p]_(m p) .& $(S2 rmhist p) .-> unchanged (m p)"
  15.163 +   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,S_def,S2_def]
  15.164 +		                   addSEs2 [action_impE Memoryidle])
  15.165 +	    ]);
  15.166 +bind_thm("S2MemUnchE", action_conjimpE S2MemUnch);
  15.167 +
  15.168 +qed_goal "S2Hist" MemoryImplementation.thy
  15.169 +   "[HNext rmhist p]_<c p,r p,m p,rmhist@p> .& $(S2 rmhist p) .-> unchanged (rmhist@p)"
  15.170 +   (fn _ => [auto_tac (MI_fast_css
  15.171 +		       addsimps2 [square_def,HNext_def,MemReturn_def,
  15.172 +				  RPCFail_def,MClkReply_def,Return_def,S_def,S2_def])
  15.173 +	    ]);
  15.174 +bind_thm("S2HistE", action_conjimpE S2Hist);
  15.175 +
  15.176 +(* ------------------------------ State S3 ---------------------------------------- *)
  15.177 +
  15.178 +qed_goal "S3EnvUnch" MemoryImplementation.thy
  15.179 +   "[ENext p]_(e p) .& $(S3 rmhist p) .-> unchanged (e p)"
  15.180 +   (fn _ => [auto_tac (MI_fast_css addSEs2 [action_impE Envbusy]
  15.181 +		                   addsimps2 [square_def,S_def,S3_def])
  15.182 +	    ]);
  15.183 +bind_thm("S3EnvUnchE", action_conjimpE S3EnvUnch);
  15.184 +
  15.185 +qed_goal "S3ClerkUnch" MemoryImplementation.thy 
  15.186 +   "[MClkNext memCh crCh cst p]_(c p) .& $(S3 rmhist p) .-> unchanged (c p)"
  15.187 +   (fn _ => [auto_tac (MI_fast_css addSEs2 [action_impE MClkbusy]
  15.188 +		                   addsimps2 [square_def,S_def,S3_def])
  15.189 +	    ]);
  15.190 +bind_thm("S3ClerkUnchE", action_conjimpE S3ClerkUnch);
  15.191 +
  15.192 +qed_goal "S3LegalRcvArg" MemoryImplementation.thy
  15.193 +   "$(S3 rmhist p) .-> IsLegalRcvArg[ arg[$(crCh@p)] ]"
  15.194 +   (fn _ => [action_simp_tac
  15.195 +	       (!simpset addsimps [IsLegalRcvArg_def,MClkRelayArg_def,S_def,S3_def])
  15.196 +	       [exI] [] 1
  15.197 +	    ]);
  15.198 +
  15.199 +qed_goal "S3RPC" MemoryImplementation.thy
  15.200 +   "(RPCNext crCh rmCh rst p) .& $(S3 rmhist p) \
  15.201 +\   .-> (RPCFwd crCh rmCh rst p) .| (RPCFail crCh rmCh rst p)"
  15.202 +   (fn _ => [auto_tac MI_css,
  15.203 +             etac ((rewrite_rule action_rews (S3LegalRcvArg RS actionD)) RS impdupE) 1,
  15.204 +	     auto_tac (MI_css addsimps2 [RPCNext_def,RPCReject_def,RPCReply_def,S_def,S3_def])
  15.205 +	    ]);
  15.206 +bind_thm("S3RPCE", action_conjimpE S3RPC);
  15.207 +
  15.208 +qed_goal "S3Forward" MemoryImplementation.thy
  15.209 +   "(RPCFwd crCh rmCh rst p) .& HNext rmhist p .& $(S3 rmhist p) .& unchanged <e p, c p, m p> \
  15.210 +\   .-> (S4 rmhist p)$ .& unchanged (rmhist@p)"
  15.211 +   (fn _ => [action_simp_tac 
  15.212 +               (!simpset addsimps [RPCFwd_def,HNext_def,MemReturn_def,RPCFail_def,MClkReply_def,
  15.213 +				   Return_def,Call_def,e_def,c_def,m_def,caller_def,rtrner_def, 
  15.214 +				   S_def,S3_def,S4_def,Calling_def])
  15.215 +	       [] [] 1
  15.216 +	    ]);
  15.217 +bind_thm("S3ForwardE", action_conjimpE S3Forward);
  15.218 +
  15.219 +qed_goal "S3Fail" MemoryImplementation.thy
  15.220 +   "(RPCFail crCh rmCh rst p) .& $(S3 rmhist p) .& HNext rmhist p .& unchanged <e p, c p, m p> \
  15.221 +\   .-> (S6 rmhist p)$"
  15.222 +   (fn _ => [action_simp_tac 
  15.223 +               (!simpset addsimps [HNext_def,RPCFail_def,Return_def,e_def,c_def,m_def,
  15.224 +				   caller_def,rtrner_def,MVOKBARF_def,
  15.225 +				   S_def,S3_def,S6_def,Calling_def])
  15.226 +               [] [] 1
  15.227 +	    ]);
  15.228 +bind_thm("S3FailE", action_conjimpE S3Fail);
  15.229 +
  15.230 +qed_goal "S3MemUnch" MemoryImplementation.thy
  15.231 +   "[RNext rmCh mem ires p]_(m p) .& $(S3 rmhist p) .-> unchanged (m p)"
  15.232 +   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,S_def,S3_def]
  15.233 +		                   addSEs2 [action_impE Memoryidle])
  15.234 +	    ]);
  15.235 +bind_thm("S3MemUnchE", action_conjimpE S3MemUnch);
  15.236 +
  15.237 +qed_goal "S3Hist" MemoryImplementation.thy
  15.238 +   "HNext rmhist p .& $(S3 rmhist p) .& unchanged (r p) .-> unchanged (rmhist@p)"
  15.239 +   (fn _ => [auto_tac (MI_fast_css
  15.240 +		       addsimps2 [HNext_def,MemReturn_def,RPCFail_def,MClkReply_def,
  15.241 +				  Return_def,r_def,rtrner_def,S_def,S3_def,Calling_def])
  15.242 +	    ]);
  15.243 +bind_thm("S3HistE", action_conjimpE S3Hist);
  15.244 +
  15.245 +
  15.246 +(* ------------------------------ State S4 ---------------------------------------- *)
  15.247 +
  15.248 +qed_goal "S4EnvUnch" MemoryImplementation.thy
  15.249 +   "[ENext p]_(e p) .& $(S4 rmhist p) .-> unchanged (e p)"
  15.250 +   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,S_def,S4_def]
  15.251 +		                   addSEs2 [action_impE Envbusy])
  15.252 +	    ]);
  15.253 +bind_thm("S4EnvUnchE", action_conjimpE S4EnvUnch);
  15.254 +
  15.255 +qed_goal "S4ClerkUnch" MemoryImplementation.thy
  15.256 +   "[MClkNext memCh crCh cst p]_(c p) .& $(S4 rmhist p) .-> unchanged (c p)"
  15.257 +   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,S_def,S4_def]
  15.258 +		                   addSEs2 [action_impE MClkbusy])
  15.259 +	    ]);
  15.260 +bind_thm("S4ClerkUnchE", action_conjimpE S4ClerkUnch);
  15.261 +
  15.262 +qed_goal "S4RPCUnch" MemoryImplementation.thy
  15.263 +   "[RPCNext crCh rmCh rst p]_(r p) .& $(S4 rmhist p) .-> unchanged (r p)"
  15.264 +   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,S_def,S4_def]
  15.265 +		                   addSEs2 [action_conjimpE RPCbusy])
  15.266 +	    ]);
  15.267 +bind_thm("S4RPCUnchE", action_conjimpE S4RPCUnch);
  15.268 +
  15.269 +qed_goal "S4ReadInner" MemoryImplementation.thy
  15.270 +   "(ReadInner rmCh mem ires p l) .& $(S4 rmhist p) .& unchanged <e p, c p, r p> \
  15.271 +\        .& (HNext rmhist p) .& $(MemInv mem l) \
  15.272 +\   .-> (S4 rmhist p)$ .& unchanged (rmhist@p)"
  15.273 +   (fn _ => [action_simp_tac 
  15.274 +               (!simpset addsimps [ReadInner_def,GoodRead_def, BadRead_def,HNext_def,
  15.275 +				   MemReturn_def, RPCFail_def,MClkReply_def,Return_def,
  15.276 +				   e_def,c_def,r_def,rtrner_def,caller_def,MVNROKBA_def,
  15.277 +				   S_def,S4_def,RdRequest_def,Calling_def,MemInv_def])
  15.278 +               [] [] 1
  15.279 +	    ]);
  15.280 +
  15.281 +qed_goal "S4Read" MemoryImplementation.thy
  15.282 +   "(Read rmCh mem ires p) .& $(S4 rmhist p) .& unchanged <e p, c p, r p> \
  15.283 +\         .& (HNext rmhist p) .& (RALL l. $(MemInv mem l)) \
  15.284 +\   .-> (S4 rmhist p)$ .& unchanged (rmhist@p)"
  15.285 +   (fn _ => [auto_tac (MI_fast_css addsimps2 [Read_def]
  15.286 +		                   addSEs2 [action_conjimpE S4ReadInner])
  15.287 +	    ]);
  15.288 +bind_thm("S4ReadE", action_conjimpE S4Read);
  15.289 +
  15.290 +qed_goal "S4WriteInner" MemoryImplementation.thy
  15.291 +   "(WriteInner rmCh mem ires p l v) .& $(S4 rmhist p) .& unchanged <e p, c p, r p> .& (HNext rmhist p) \
  15.292 +\   .-> (S4 rmhist p)$ .& unchanged (rmhist@p)"
  15.293 +   (fn _ => [action_simp_tac 
  15.294 +               (!simpset addsimps [WriteInner_def,GoodWrite_def, BadWrite_def,HNext_def,
  15.295 +				   MemReturn_def,RPCFail_def,MClkReply_def,Return_def,
  15.296 +				   e_def,c_def,r_def,rtrner_def,caller_def,MVNROKBA_def, 
  15.297 +				   S_def,S4_def,WrRequest_def,Calling_def])
  15.298 +               [] [] 1
  15.299 +	    ]);
  15.300 +
  15.301 +qed_goal "S4Write" MemoryImplementation.thy
  15.302 +   "(Write rmCh mem ires p l) .& $(S4 rmhist p) .& unchanged <e p, c p, r p> .& (HNext rmhist p) \
  15.303 +\   .-> (S4 rmhist p)$ .& unchanged (rmhist@p)"
  15.304 +   (fn _ => [ auto_tac (MI_css addsimps2 [Write_def] addSEs2 [action_conjimpE S4WriteInner]) ]);
  15.305 +bind_thm("S4WriteE", action_conjimpE S4Write);
  15.306 +
  15.307 +qed_goal "WriteS4" MemoryImplementation.thy
  15.308 +   "$(ImpInv rmhist p) .& (Write rmCh mem ires p l) .-> $(S4 rmhist p)"
  15.309 +   (fn _ => [auto_tac (MI_fast_css
  15.310 +		       addsimps2 [Write_def,WriteInner_def,ImpInv_def,WrRequest_def,
  15.311 +				  S_def,S1_def,S2_def,S3_def,S4_def,S5_def,S6_def])
  15.312 +            ]);
  15.313 +bind_thm("WriteS4E", action_conjimpE WriteS4);
  15.314 +
  15.315 +qed_goal "S4Return" MemoryImplementation.thy
  15.316 +   "(MemReturn rmCh ires p) .& $(S4 rmhist p) .& unchanged <e p, c p, r p> .& (HNext rmhist p) \
  15.317 +\   .-> (S5 rmhist p)$"
  15.318 +   (fn _ => [auto_tac (MI_fast_css
  15.319 +		       addsimps2 [HNext_def,MemReturn_def,Return_def,e_def,c_def,r_def,
  15.320 +				  rtrner_def,caller_def,MVNROKBA_def,MVOKBA_def,
  15.321 +		                  S_def,S4_def,S5_def,Calling_def])
  15.322 +	    ]);
  15.323 +bind_thm("S4ReturnE", action_conjimpE S4Return);
  15.324 +
  15.325 +qed_goal "S4Hist" MemoryImplementation.thy
  15.326 +   "(HNext rmhist p) .& $(S4 rmhist p) .& (m p)$ .= $(m p) .-> (rmhist@p)$ .= $(rmhist@p)"
  15.327 +   (fn _ => [auto_tac (MI_fast_css
  15.328 +		       addsimps2 [HNext_def,MemReturn_def,RPCFail_def,MClkReply_def,
  15.329 +				  Return_def,m_def,rtrner_def,S_def,S4_def,Calling_def])
  15.330 +	    ]);
  15.331 +bind_thm("S4HistE", action_conjimpE S4Hist);
  15.332 +
  15.333 +(* ------------------------------ State S5 ---------------------------------------- *)
  15.334 +
  15.335 +qed_goal "S5EnvUnch" MemoryImplementation.thy
  15.336 +   "[ENext p]_(e p) .& $(S5 rmhist p) .-> unchanged (e p)"
  15.337 +   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,S_def,S5_def]
  15.338 +		                   addSEs2 [action_impE Envbusy])
  15.339 +	    ]);
  15.340 +bind_thm("S5EnvUnchE", action_conjimpE S5EnvUnch);
  15.341 +
  15.342 +qed_goal "S5ClerkUnch" MemoryImplementation.thy
  15.343 +   "[MClkNext memCh crCh cst p]_(c p) .& $(S5 rmhist p) .-> unchanged (c p)"
  15.344 +   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,S_def,S5_def]
  15.345 +		                   addSEs2 [action_impE MClkbusy])
  15.346 +	    ]);
  15.347 +bind_thm("S5ClerkUnchE", action_conjimpE S5ClerkUnch);
  15.348 +
  15.349 +qed_goal "S5RPC" MemoryImplementation.thy
  15.350 +   "(RPCNext crCh rmCh rst p) .& $(S5 rmhist p)   \
  15.351 +\   .-> (RPCReply crCh rmCh rst p) .| (RPCFail crCh rmCh rst p)"
  15.352 +   (fn _ => [auto_tac (MI_fast_css
  15.353 +		       addsimps2 [RPCNext_def,RPCReject_def,RPCFwd_def,S_def,S5_def])
  15.354 +	    ]);
  15.355 +bind_thm("S5RPCE", action_conjimpE S5RPC);
  15.356 +
  15.357 +qed_goal "S5Reply" MemoryImplementation.thy
  15.358 +   "(RPCReply crCh rmCh rst p) .& $(S5 rmhist p) .& unchanged <e p, c p, m p,rmhist@p> \
  15.359 +\    .-> (S6 rmhist p)$"
  15.360 +   (fn _ => [action_simp_tac 
  15.361 +               (!simpset
  15.362 +		addsimps [RPCReply_def,Return_def,e_def,c_def,m_def,
  15.363 +			  MVOKBA_def,MVOKBARF_def,caller_def,rtrner_def,
  15.364 +			  S_def,S5_def,S6_def,Calling_def])
  15.365 +               [] [] 1
  15.366 +	    ]);
  15.367 +bind_thm("S5ReplyE", action_conjimpE S5Reply);
  15.368 +
  15.369 +qed_goal "S5Fail" MemoryImplementation.thy
  15.370 +   "(RPCFail crCh rmCh rst p) .& $(S5 rmhist p) .& unchanged <e p, c p, m p,rmhist@p>\
  15.371 +\     .-> (S6 rmhist p)$"
  15.372 +   (fn _ => [action_simp_tac
  15.373 +	       (!simpset
  15.374 +		addsimps [RPCFail_def,Return_def,e_def,c_def,m_def,
  15.375 +			  MVOKBARF_def,caller_def,rtrner_def,
  15.376 +			  S_def,S5_def,S6_def,Calling_def])
  15.377 +               [] [] 1
  15.378 +	    ]);
  15.379 +bind_thm("S5FailE", action_conjimpE S5Fail);
  15.380 +
  15.381 +qed_goal "S5MemUnch" MemoryImplementation.thy
  15.382 +   "[RNext rmCh mem ires p]_(m p) .& $(S5 rmhist p) .-> unchanged (m p)"
  15.383 +   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,S_def,S5_def]
  15.384 +		                   addSEs2 [action_impE Memoryidle])
  15.385 +	    ]);
  15.386 +bind_thm("S5MemUnchE", action_conjimpE S5MemUnch);
  15.387 +
  15.388 +qed_goal "S5Hist" MemoryImplementation.thy
  15.389 +   "[HNext rmhist p]_<c p, r p, m p, rmhist@p> .& $(S5 rmhist p) .-> (rmhist@p)$ .= $(rmhist@p)"
  15.390 +   (fn _ => [auto_tac (MI_fast_css
  15.391 +		       addsimps2 [square_def,HNext_def,MemReturn_def,
  15.392 +				  RPCFail_def,MClkReply_def,Return_def,S_def,S5_def])
  15.393 +	    ]);
  15.394 +bind_thm("S5HistE", action_conjimpE S5Hist);
  15.395 +
  15.396 +(* ------------------------------ State S6 ---------------------------------------- *)
  15.397 +
  15.398 +qed_goal "S6EnvUnch" MemoryImplementation.thy
  15.399 +   "[ENext p]_(e p) .& $(S6 rmhist p) .-> unchanged (e p)"
  15.400 +   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,S_def,S6_def]
  15.401 +		                   addSEs2 [action_impE Envbusy])
  15.402 +	    ]);
  15.403 +bind_thm("S6EnvUnchE", action_conjimpE S6EnvUnch);
  15.404 +
  15.405 +qed_goal "S6Clerk" MemoryImplementation.thy
  15.406 +   "(MClkNext memCh crCh cst p) .& $(S6 rmhist p) \
  15.407 +\    .-> (MClkRetry memCh crCh cst p) .| (MClkReply memCh crCh cst p)"
  15.408 +   (fn _ => [ auto_tac (MI_fast_css addsimps2 [MClkNext_def,MClkFwd_def,S_def,S6_def]) ]);
  15.409 +bind_thm("S6ClerkE", action_conjimpE S6Clerk);
  15.410 +
  15.411 +qed_goal "S6Retry" MemoryImplementation.thy
  15.412 +   "(MClkRetry memCh crCh cst p) .& (HNext rmhist p) .& $(S6 rmhist p) .& unchanged<e p,r p,m p> \
  15.413 +\     .-> (S3 rmhist p)$ .& unchanged (rmhist@p)"
  15.414 +   (fn _ => [action_simp_tac
  15.415 +	        (!simpset addsimps [HNext_def,MClkReply_def,MClkRetry_def,Call_def,
  15.416 +				    Return_def,e_def,r_def,m_def,caller_def,rtrner_def,
  15.417 +		                    S_def,S6_def,S3_def,Calling_def])
  15.418 +                [] [] 1]);
  15.419 +bind_thm("S6RetryE", action_conjimpE S6Retry);
  15.420 +
  15.421 +qed_goal "S6Reply" MemoryImplementation.thy
  15.422 +   "(MClkReply memCh crCh cst p) .& (HNext rmhist p) .& $(S6 rmhist p) .& unchanged<e p,r p,m p> \
  15.423 +\     .-> (S1 rmhist p)$"
  15.424 +   (fn _ => [action_simp_tac (!simpset
  15.425 +			      addsimps [HNext_def,MemReturn_def,RPCFail_def,Return_def,
  15.426 +					MClkReply_def,e_def,r_def,m_def,caller_def,rtrner_def,
  15.427 +					S_def,S6_def,S1_def,Calling_def])
  15.428 +	                     [] [] 1
  15.429 +	    ]);
  15.430 +bind_thm("S6ReplyE", action_conjimpE S6Reply);
  15.431 +
  15.432 +qed_goal "S6RPCUnch" MemoryImplementation.thy
  15.433 +   "[RPCNext crCh rmCh rst p]_(r p) .& $(S6 rmhist p) .-> unchanged (r p)"
  15.434 +   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,S_def,S6_def]
  15.435 +		                   addSEs2 [action_impE RPCidle])
  15.436 +	    ]);
  15.437 +bind_thm("S6RPCUnchE", action_conjimpE S6RPCUnch);
  15.438 +
  15.439 +qed_goal "S6MemUnch" MemoryImplementation.thy
  15.440 +   "[RNext rmCh mem ires p]_(m p) .& $(S6 rmhist p) .-> unchanged (m p)"
  15.441 +   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,S_def,S6_def]
  15.442 +		                   addSEs2 [action_impE Memoryidle])
  15.443 +	    ]);
  15.444 +bind_thm("S6MemUnchE", action_conjimpE S6MemUnch);
  15.445 +
  15.446 +qed_goal "S6Hist" MemoryImplementation.thy
  15.447 +   "(HNext rmhist p) .& $(S6 rmhist p) .& (c p)$ .= $(c p) .-> (rmhist@p)$ .= $(rmhist@p)"
  15.448 +   (fn _ => [auto_tac (MI_fast_css
  15.449 +		       addsimps2 [HNext_def,MClkReply_def,Return_def,c_def,rtrner_def,
  15.450 +		                  S_def,S6_def,Calling_def])
  15.451 +	    ]);
  15.452 +bind_thm("S6HistE", action_conjimpE S6Hist);
    16.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    16.2 +++ b/src/HOL/TLA/Memory/MemClerk.ML	Wed Oct 08 11:50:33 1997 +0200
    16.3 @@ -0,0 +1,71 @@
    16.4 +(* 
    16.5 +    File:        MemClerk.ML
    16.6 +    Author:      Stephan Merz
    16.7 +    Copyright:   1997 University of Munich
    16.8 +
    16.9 +    RPC-Memory example: Memory clerk specification (ML file)
   16.10 +*)
   16.11 +
   16.12 +val MC_action_defs = 
   16.13 +   [MClkInit_def RS inteq_reflection]
   16.14 +   @ [MClkFwd_def, MClkRetry_def, MClkReply_def, MClkNext_def];
   16.15 +
   16.16 +val MC_temp_defs = [MClkIPSpec_def, MClkISpec_def];
   16.17 +
   16.18 +(* The Clerk engages in an action for process p only if there is an outstanding,
   16.19 +   unanswered call for that process.
   16.20 +*)
   16.21 +
   16.22 +qed_goal "MClkidle" MemClerk.thy
   16.23 +   ".~ $(Calling send p) .& ($(cst@p) .= #clkA) .-> .~ MClkNext send rcv cst p"
   16.24 +   (fn _ => [ auto_tac (!claset,
   16.25 +                        !simpset addsimps (MC_action_defs @ [Return_def]))
   16.26 +            ]);
   16.27 +
   16.28 +qed_goal "MClkbusy" MemClerk.thy
   16.29 +   "$(Calling rcv p) .-> .~ MClkNext send rcv cst p"
   16.30 +   (fn _ => [ auto_tac (!claset,
   16.31 +                        !simpset addsimps (MC_action_defs @ [Call_def]))
   16.32 +            ]);
   16.33 +
   16.34 +(* unlifted versions as introduction rules *)
   16.35 +
   16.36 +bind_thm("MClkidleI", action_mp MClkidle);
   16.37 +bind_thm("MClkbusyI", action_mp MClkbusy);
   16.38 +
   16.39 +(* Enabledness of actions *)
   16.40 +
   16.41 +qed_goal "MClkFwd_enabled" MemClerk.thy
   16.42 +   "!!p. base_var <rtrner send @ p, caller rcv @ p, cst@p> ==> \
   16.43 +\        $(Calling send p) .& .~ $(Calling rcv p) .& ($(cst@p) .= #clkA)  \
   16.44 +\        .-> $(Enabled (MClkFwd send rcv cst p))"
   16.45 +   (fn _ => [action_simp_tac (!simpset addsimps [MClkFwd_def,Call_def,caller_def,rtrner_def])
   16.46 +                             [] [base_enabled,Pair_inject] 1]);
   16.47 +
   16.48 +qed_goal "MClkFwd_ch_enabled" MemClerk.thy
   16.49 +   "Enabled (MClkFwd send rcv cst p) s  \
   16.50 +\   ==> Enabled (<MClkFwd send rcv cst p>_<cst@p, rtrner send @ p, caller rcv @ p>) s"
   16.51 +   (fn [prem] => [auto_tac (!claset addSIs [prem RS enabled_mono],
   16.52 +			    !simpset addsimps [angle_def,MClkFwd_def])
   16.53 +		 ]);
   16.54 +
   16.55 +qed_goal "MClkReply_change" MemClerk.thy
   16.56 +   "MClkReply send rcv cst p .-> <MClkReply send rcv cst p>_<cst@p, rtrner send @ p, caller rcv @ p>"
   16.57 +   (fn _ => [auto_tac (action_css addsimps2 [angle_def,MClkReply_def]
   16.58 +			          addEs2 [Return_changedE])
   16.59 +            ]);
   16.60 +
   16.61 +qed_goal "MClkReply_enabled" MemClerk.thy
   16.62 +   "!!p. base_var <rtrner send @ p, caller rcv @ p, cst@p> ==> \
   16.63 +\        $(Calling send p) .& .~ $(Calling rcv p) .& ($(cst@p) .= #clkB)  \
   16.64 +\        .-> $(Enabled (<MClkReply send rcv cst p>_<cst@p, rtrner send @ p, caller rcv @ p>))"
   16.65 +   (fn _ => [action_simp_tac (!simpset) [MClkReply_change RSN (2,enabled_mono)] [] 1,
   16.66 +	     action_simp_tac (!simpset addsimps [MClkReply_def,Return_def,caller_def,rtrner_def])
   16.67 +                             [] [base_enabled,Pair_inject] 1
   16.68 +	    ]);
   16.69 +
   16.70 +qed_goal "MClkReplyNotRetry" MemClerk.thy
   16.71 +   "MClkReply send rcv cst p .-> .~(MClkRetry send rcv cst p)"
   16.72 +   (fn _ => [ auto_tac (!claset,
   16.73 +			!simpset addsimps [MClkReply_def,MClkRetry_def]) 
   16.74 +	    ]);
    17.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    17.2 +++ b/src/HOL/TLA/Memory/MemClerk.thy	Wed Oct 08 11:50:33 1997 +0200
    17.3 @@ -0,0 +1,72 @@
    17.4 +(*
    17.5 +    File:        MemClerk.thy
    17.6 +    Author:      Stephan Merz
    17.7 +    Copyright:   1997 University of Munich
    17.8 +
    17.9 +    Theory Name: MemClerk
   17.10 +    Logic Image: TLA
   17.11 +
   17.12 +    RPC-Memory example: specification of the memory clerk.
   17.13 +*)
   17.14 +
   17.15 +MemClerk = Memory + RPC + MemClerkParameters +
   17.16 +
   17.17 +types
   17.18 +  (* The clerk takes the same arguments as the memory and sends requests to the RPC *)
   17.19 +  mClkSndChType = "memChType"
   17.20 +  mClkRcvChType = "rpcSndChType"
   17.21 +  mClkStType    = "(PrIds => mClkState) stfun"
   17.22 +
   17.23 +consts
   17.24 +  (* state predicates *)
   17.25 +  MClkInit      :: "mClkRcvChType => mClkStType => PrIds => stpred"
   17.26 +
   17.27 +  (* actions *)
   17.28 +  MClkFwd       :: "mClkSndChType => mClkRcvChType => mClkStType => PrIds => action"
   17.29 +  MClkRetry     :: "mClkSndChType => mClkRcvChType => mClkStType => PrIds => action"
   17.30 +  MClkReply     :: "mClkSndChType => mClkRcvChType => mClkStType => PrIds => action"
   17.31 +  MClkNext      :: "mClkSndChType => mClkRcvChType => mClkStType => PrIds => action"
   17.32 +
   17.33 +  (* temporal *)
   17.34 +  MClkIPSpec    :: "mClkSndChType => mClkRcvChType => mClkStType => PrIds => temporal"
   17.35 +  MClkISpec     :: "mClkSndChType => mClkRcvChType => mClkStType => temporal"
   17.36 +
   17.37 +rules
   17.38 +  MClkInit_def     "$(MClkInit rcv cst p) .=
   17.39 +                        ($(cst@p) .= #clkA  .&  .~ $(Calling rcv p))"
   17.40 +
   17.41 +  MClkFwd_def      "MClkFwd send rcv cst p ==
   17.42 +                        $(Calling send p)
   17.43 +                        .& $(cst@p) .= #clkA
   17.44 +                        .& Call rcv p (MClkRelayArg[ arg[$(send@p)] ])
   17.45 +                        .& (cst@p)$ .= #clkB
   17.46 +                        .& unchanged (rtrner send @ p)"
   17.47 +
   17.48 +  MClkRetry_def    "MClkRetry send rcv cst p ==
   17.49 +                        $(cst@p) .= #clkB
   17.50 +                        .& res[$(rcv@p)] .= #RPCFailure
   17.51 +                        .& Call rcv p (MClkRelayArg[ arg[$(send@p)] ])
   17.52 +                        .& unchanged <cst@p, rtrner send @ p>"
   17.53 +
   17.54 +  MClkReply_def    "MClkReply send rcv cst p ==
   17.55 +                        .~ $(Calling rcv p)
   17.56 +                        .& $(cst@p) .= #clkB
   17.57 +                        .& Return send p (MClkReplyVal[ res[$(rcv@p)] ])
   17.58 +                        .& (cst@p)$ .= #clkA
   17.59 +                        .& unchanged (caller rcv @ p)"
   17.60 +
   17.61 +  MClkNext_def     "MClkNext send rcv cst p ==
   17.62 +                        MClkFwd send rcv cst p
   17.63 +                        .| MClkRetry send rcv cst p
   17.64 +                        .| MClkReply send rcv cst p"
   17.65 +
   17.66 +  MClkIPSpec_def   "MClkIPSpec send rcv cst p ==
   17.67 +                        Init($(MClkInit rcv cst p))
   17.68 +                        .& [][ MClkNext send rcv cst p ]_<cst@p, rtrner send @ p, caller rcv @ p>
   17.69 +                        .& WF(MClkFwd send rcv cst p)_<cst@p, rtrner send @ p, caller rcv @ p>
   17.70 +                        .& SF(MClkReply send rcv cst p)_<cst@p, rtrner send @ p, caller rcv @ p>"
   17.71 +
   17.72 +  MClkISpec_def    "MClkISpec send rcv cst == RALL p. MClkIPSpec send rcv cst p"
   17.73 +end
   17.74 +
   17.75 +
    18.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    18.2 +++ b/src/HOL/TLA/Memory/MemClerkParameters.ML	Wed Oct 08 11:50:33 1997 +0200
    18.3 @@ -0,0 +1,11 @@
    18.4 +(* 
    18.5 +    File:        MemClerkParameters.ML
    18.6 +    Author:      Stephan Merz
    18.7 +    Copyright:   1997 University of Munich
    18.8 +
    18.9 +    RPC-Memory example: Memory clerk parameters (ML file)
   18.10 +*)
   18.11 +
   18.12 +val CP_simps = RP_simps @ mClkState.simps;
   18.13 +
   18.14 +
    19.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    19.2 +++ b/src/HOL/TLA/Memory/MemClerkParameters.thy	Wed Oct 08 11:50:33 1997 +0200
    19.3 @@ -0,0 +1,34 @@
    19.4 +(*
    19.5 +    File:        MemClerkParameters.thy
    19.6 +    Author:      Stephan Merz
    19.7 +    Copyright:   1997 University of Munich
    19.8 +
    19.9 +    Theory Name: MemClerkParameters
   19.10 +    Logic Image: TLA
   19.11 +
   19.12 +    RPC-Memory example: Parameters of the memory clerk.
   19.13 +*)
   19.14 +
   19.15 +MemClerkParameters = RPCParameters + 
   19.16 +
   19.17 +datatype  mClkState  =  clkA | clkB
   19.18 +
   19.19 +types
   19.20 +  (* types sent on the clerk's send and receive channels are argument types
   19.21 +     of the memory and the RPC, respectively *)
   19.22 +  mClkSndArgType   = "memArgType"
   19.23 +  mClkRcvArgType   = "rpcArgType"
   19.24 +
   19.25 +consts
   19.26 +  (* translate a memory call to an RPC call *)
   19.27 +  MClkRelayArg     :: "memArgType => rpcArgType"
   19.28 +  (* translate RPC failures to memory failures *)
   19.29 +  MClkReplyVal     :: "Vals => Vals"
   19.30 +
   19.31 +rules
   19.32 +  MClkRelayArg_def    "MClkRelayArg marg == Inl (remoteCall, marg)"
   19.33 +  MClkReplyVal_def    "MClkReplyVal v == 
   19.34 +                           if v = RPCFailure then MemFailure else v"
   19.35 +
   19.36 +end
   19.37 +
    20.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    20.2 +++ b/src/HOL/TLA/Memory/Memory.ML	Wed Oct 08 11:50:33 1997 +0200
    20.3 @@ -0,0 +1,160 @@
    20.4 +(* 
    20.5 +    File:        Memory.ML
    20.6 +    Author:      Stephan Merz
    20.7 +    Copyright:   1997 University of Munich
    20.8 +
    20.9 +    RPC-Memory example: Memory specification (ML file)
   20.10 +*)
   20.11 +
   20.12 +val RM_action_defs = 
   20.13 +   (map (fn t => t RS inteq_reflection)
   20.14 +        [MInit_def, PInit_def, RdRequest_def, WrRequest_def, MemInv_def])
   20.15 +   @ [GoodRead_def, BadRead_def, ReadInner_def, Read_def,
   20.16 +      GoodWrite_def, BadWrite_def, WriteInner_def, Write_def,
   20.17 +      MemReturn_def, RNext_def];
   20.18 +
   20.19 +val UM_action_defs = RM_action_defs @ [MemFail_def, UNext_def];
   20.20 +
   20.21 +val RM_temp_defs = [RPSpec_def, MSpec_def, IRSpec_def];
   20.22 +val UM_temp_defs = [UPSpec_def, MSpec_def, IUSpec_def];
   20.23 +
   20.24 +(* Make sure the simpset accepts non-boolean simplifications *)
   20.25 +simpset := !simpset setmksimps ((mksimps mksimps_pairs) o maybe_unlift);
   20.26 +
   20.27 +(* -------------------- Proofs -------------------------------------------------- *)
   20.28 +
   20.29 +(* The reliable memory is an implementation of the unreliable one *)
   20.30 +qed_goal "ReliableImplementsUnReliable" Memory.thy 
   20.31 +   "IRSpec ch mm rs .-> IUSpec ch mm rs"
   20.32 +   (fn _ => [auto_tac (temp_css addsimps2 ([square_def,UNext_def] @ RM_temp_defs @ UM_temp_defs)
   20.33 +		                addSEs2 [STL4E])
   20.34 +	    ]);
   20.35 +
   20.36 +(* The memory spec implies the memory invariant *)
   20.37 +qed_goal "MemoryInvariant" Memory.thy 
   20.38 +   "(MSpec ch mm rs l) .-> []($(MemInv mm l))"
   20.39 +   (fn _ => [ auto_inv_tac (!simpset addsimps RM_temp_defs @ MP_simps @ RM_action_defs) 1 ]);
   20.40 +
   20.41 +(* The invariant is trivial for non-locations *)
   20.42 +qed_goal "NonMemLocInvariant" Memory.thy
   20.43 +   ".~ #(MemLoc l) .-> []($MemInv mm l)"
   20.44 +   (fn _ => [ auto_tac (temp_css addsimps2 [MemInv_def] addSIs2 [necT RS tempD]) ]);
   20.45 +
   20.46 +qed_goal "MemoryInvariantAll" Memory.thy
   20.47 +   "((RALL l. #(MemLoc l) .-> MSpec ch mm rs l)) .-> (RALL l. []($MemInv mm l))"
   20.48 +   (fn _ => [step_tac temp_cs 1,
   20.49 +	     case_tac "MemLoc l" 1,
   20.50 +	     auto_tac (temp_css addSEs2 (map temp_mp [MemoryInvariant,NonMemLocInvariant]))
   20.51 +	    ]);
   20.52 +
   20.53 +(* The memory engages in an action for process p only if there is an unanswered call from p.
   20.54 +   We need this only for the reliable memory.
   20.55 +*)
   20.56 +
   20.57 +qed_goal "Memoryidle" Memory.thy
   20.58 +   ".~ $(Calling ch p) .-> .~ RNext ch mm rs p"
   20.59 +   (fn _ => [ auto_tac (action_css addsimps2 (RM_action_defs @ [Return_def])) ]);
   20.60 +
   20.61 +bind_thm("MemoryidleI", action_mp Memoryidle);
   20.62 +bind_thm("MemoryidleE", action_impE Memoryidle);
   20.63 +
   20.64 +
   20.65 +(* Enabledness conditions *)
   20.66 +
   20.67 +qed_goal "MemReturn_change" Memory.thy
   20.68 +   "MemReturn ch rs p .-> <MemReturn ch rs p>_<rtrner ch @ p, rs@p>"
   20.69 +   (fn _ => [ auto_tac (action_css addsimps2 [MemReturn_def,angle_def]) ]);
   20.70 +
   20.71 +qed_goal "MemReturn_enabled" Memory.thy
   20.72 +   "!!p. base_var <rtrner ch @ p, rs@p> ==> \
   20.73 +\        $(Calling ch p) .& ($(rs@p) .~= #NotAResult) \
   20.74 +\        .-> $(Enabled (<MemReturn ch rs p>_<rtrner ch @ p, rs@p>))"
   20.75 +   (fn _ => [action_simp_tac (!simpset) [MemReturn_change RSN (2,enabled_mono)] [] 1,
   20.76 +             action_simp_tac (!simpset addsimps [MemReturn_def,Return_def,rtrner_def])
   20.77 +                             [] [base_enabled,Pair_inject] 1
   20.78 +	    ]);
   20.79 +
   20.80 +qed_goal "ReadInner_enabled" Memory.thy
   20.81 +   "!!p. base_var <rtrner ch @ p, rs@p> ==> \
   20.82 +\        $(Calling ch p) .& (arg[$(ch@p)] .= #(Inl (read,l))) \
   20.83 +\        .-> $(Enabled (ReadInner ch mm rs p l))"
   20.84 +   (fn _ => [Action_simp_tac 1,
   20.85 +               (* unlift before applying case_tac: case_split_thm expects boolean conclusion *)
   20.86 +	     case_tac "MemLoc l" 1,
   20.87 +             ALLGOALS
   20.88 +	        (action_simp_tac 
   20.89 +                    (!simpset addsimps [ReadInner_def,GoodRead_def,BadRead_def,
   20.90 +					RdRequest_def])
   20.91 +                    [] [base_enabled,Pair_inject])
   20.92 +            ]);
   20.93 +
   20.94 +qed_goal "WriteInner_enabled" Memory.thy
   20.95 +   "!!p. base_var <rtrner ch @ p, mm@l, rs@p> ==> \
   20.96 +\        $(Calling ch p) .& (arg[$(ch@p)] .= #(Inr (write,l,v))) \
   20.97 +\        .-> $(Enabled (WriteInner ch mm rs p l v))"
   20.98 +   (fn _ => [Action_simp_tac 1,
   20.99 +	     case_tac "MemLoc l & MemVal v" 1,
  20.100 +             ALLGOALS
  20.101 +	        (action_simp_tac 
  20.102 +                    (!simpset addsimps [WriteInner_def,GoodWrite_def,BadWrite_def,
  20.103 +					WrRequest_def])
  20.104 +                    [] [base_enabled,Pair_inject])
  20.105 +            ]);
  20.106 +
  20.107 +qed_goal "ReadResult" Memory.thy
  20.108 +   "(Read ch mm rs p) .& (RALL l. $(MemInv mm l)) .-> (rs@p)$ .~= #NotAResult"
  20.109 +   (fn _ => [action_simp_tac 
  20.110 +               (!simpset addsimps (MP_simps 
  20.111 +				   @ [Read_def,ReadInner_def,GoodRead_def,
  20.112 +				      BadRead_def,MemInv_def]))
  20.113 +	       [] [] 1,
  20.114 +	     auto_tac (action_css addsimps2 MP_simps) ]);
  20.115 +
  20.116 +qed_goal "WriteResult" Memory.thy
  20.117 +   "(Write ch mm rs p l) .-> (rs@p)$ .~= #NotAResult"
  20.118 +   (fn _ => [auto_tac (!claset,
  20.119 +		       !simpset addsimps (MP_simps @
  20.120 +				   [Write_def,WriteInner_def,GoodWrite_def,BadWrite_def]))
  20.121 +	    ]);
  20.122 +
  20.123 +qed_goal "ReturnNotReadWrite" Memory.thy
  20.124 +   "(RALL l. $MemInv mm l) .& (MemReturn ch rs p) \
  20.125 +\   .-> .~(Read ch mm rs p) .& (RALL l. .~(Write ch mm rs p l))"
  20.126 +   (fn _ => [auto_tac
  20.127 +	       (action_css addsimps2 [MemReturn_def]
  20.128 +		           addSEs2 [action_impE WriteResult,action_conjimpE ReadResult])
  20.129 +	    ]);
  20.130 +
  20.131 +qed_goal "RWRNext_enabled" Memory.thy
  20.132 +   "($(rs@p) .= #NotAResult) .& (RALL l. $(MemInv mm l))  \
  20.133 +\      .& $(Enabled (Read ch mm rs p .| (REX l. Write ch mm rs p l))) \
  20.134 +\   .-> $(Enabled (<RNext ch mm rs p>_<rtrner ch @ p, rs@p>))"
  20.135 +   (fn _ => [auto_tac
  20.136 +	       (action_css addsimps2 [RNext_def,angle_def]
  20.137 +		     addSEs2 [enabled_mono2]
  20.138 +		     addEs2 [action_conjimpE ReadResult,action_impE WriteResult])
  20.139 +	    ]);
  20.140 +
  20.141 +
  20.142 +(* Combine previous lemmas: the memory can make a visible step if there is an
  20.143 +   outstanding call for which no result has been produced.
  20.144 +*)
  20.145 +qed_goal "RNext_enabled" Memory.thy
  20.146 +   "!!p. (ALL l. base_var <rtrner ch @ p, mm@l, rs@p>) ==> \
  20.147 +\        ($(rs@p) .= #NotAResult) .& $(Calling ch p) .& (RALL l. $(MemInv mm l))  \
  20.148 +\        .-> $(Enabled (<RNext ch mm rs p>_<rtrner ch @ p, rs@p>))"
  20.149 +   (fn _ => [auto_tac (action_css addsimps2 [enabled_disj]
  20.150 +		                  addSIs2 [action_mp RWRNext_enabled]),
  20.151 +	     res_inst_tac [("s","arg(ch s p)")] sumE 1,
  20.152 +	     action_simp_tac (!simpset addsimps [Read_def,enabled_ex,base_pair])
  20.153 +	                     [action_mp ReadInner_enabled,exI] [] 1,
  20.154 +	     split_all_tac 1, Rd.induct_tac "xa" 1,
  20.155 +	     (* introduce a trivial subgoal to solve flex-flex constraint?! *)
  20.156 +	     subgoal_tac "y = snd(xa,y)" 1,
  20.157 +	     TRYALL Simp_tac,  (* solves "read" case *)
  20.158 +	     etac swap 1,
  20.159 +	     action_simp_tac (!simpset addsimps [Write_def,enabled_ex,base_pair])
  20.160 +	                     [action_mp WriteInner_enabled,exI] [] 1,
  20.161 +	     split_all_tac 1, Wr.induct_tac "x" 1,
  20.162 +	     subgoal_tac "(xa = fst(snd(x,xa,y))) & (y = snd(snd(x,xa,y)))" 1,
  20.163 +	     ALLGOALS Simp_tac ]);
    21.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    21.2 +++ b/src/HOL/TLA/Memory/Memory.thy	Wed Oct 08 11:50:33 1997 +0200
    21.3 @@ -0,0 +1,137 @@
    21.4 +(*
    21.5 +    File:        Memory.thy
    21.6 +    Author:      Stephan Merz
    21.7 +    Copyright:   1997 University of Munich
    21.8 +
    21.9 +    Theory Name: Memory
   21.10 +    Logic Image: TLA
   21.11 +
   21.12 +    RPC-Memory example: Memory specification
   21.13 +*)
   21.14 +
   21.15 +Memory = MemoryParameters + ProcedureInterface +
   21.16 +
   21.17 +types
   21.18 +  memChType  = "(memArgType,Vals) channel"
   21.19 +  memType = "(Locs => Vals) stfun"      (* intention: MemLocs => MemVals *)
   21.20 +  resType = "(PrIds => Vals) stfun"
   21.21 +
   21.22 +consts
   21.23 +  (* state predicates *)
   21.24 +  MInit      :: "memType => Locs => stpred"
   21.25 +  PInit      :: "resType => PrIds => stpred"
   21.26 +  (* auxiliary predicates: is there a pending read/write request for
   21.27 +     some process id and location/value? *)
   21.28 +  RdRequest  :: "memChType => PrIds => Locs => stpred"
   21.29 +  WrRequest  :: "memChType => PrIds => Locs => Vals => stpred"
   21.30 +
   21.31 +  (* actions *)
   21.32 +  GoodRead   :: "memType => resType => PrIds => Locs => action"
   21.33 +  BadRead    :: "memType => resType => PrIds => Locs => action"
   21.34 +  ReadInner  :: "memChType => memType => resType => PrIds => Locs => action"
   21.35 +  Read       :: "memChType => memType => resType => PrIds => action"
   21.36 +  GoodWrite  :: "memType => resType => PrIds => Locs => Vals => action"
   21.37 +  BadWrite   :: "memType => resType => PrIds => Locs => Vals => action"
   21.38 +  WriteInner :: "memChType => memType => resType => PrIds => Locs => Vals => action"
   21.39 +  Write      :: "memChType => memType => resType => PrIds => Locs => action"
   21.40 +  MemReturn  :: "memChType => resType => PrIds => action"
   21.41 +  MemFail    :: "memChType => resType => PrIds => action"
   21.42 +  RNext      :: "memChType => memType => resType => PrIds => action"
   21.43 +  UNext      :: "memChType => memType => resType => PrIds => action"
   21.44 +
   21.45 +  (* temporal formulas *)
   21.46 +  RPSpec     :: "memChType => memType => resType => PrIds => temporal"
   21.47 +  UPSpec     :: "memChType => memType => resType => PrIds => temporal"
   21.48 +  MSpec      :: "memChType => memType => resType => Locs => temporal"
   21.49 +  IRSpec     :: "memChType => memType => resType => temporal"
   21.50 +  IUSpec     :: "memChType => memType => resType => temporal"
   21.51 +
   21.52 +  RSpec      :: "memChType => resType => temporal"
   21.53 +  USpec      :: "memChType => temporal"
   21.54 +
   21.55 +  (* memory invariant: in the paper, the invariant is hidden in the definition of
   21.56 +     the predicate S used in the implementation proof, but it is easier to verify 
   21.57 +     at this level. *)
   21.58 +  MemInv    :: "memType => Locs => stpred"
   21.59 +
   21.60 +rules
   21.61 +  MInit_def         "$(MInit mm l) .= ($(mm@l) .= # InitVal)"
   21.62 +  PInit_def         "$(PInit rs p) .= ($(rs@p) .= # NotAResult)"
   21.63 +
   21.64 +  RdRequest_def     "$(RdRequest ch p l) .= 
   21.65 +                         ($(Calling ch p) .& (arg[$(ch@p)] .= #(Inl (read,l))))"
   21.66 +  WrRequest_def     "$(WrRequest ch p l v) .=
   21.67 +                         ($(Calling ch p) .& (arg[$(ch@p)] .= #(Inr (write,l,v))))"
   21.68 +  (* a read that doesn't raise BadArg *)
   21.69 +  GoodRead_def      "GoodRead mm rs p l ==
   21.70 +                        #(MemLoc l) .& (rs@p)$ .= $(mm@l)"
   21.71 +  (* a read that raises BadArg *)
   21.72 +  BadRead_def       "BadRead mm rs p l ==
   21.73 +                        .~ #(MemLoc l) .& (rs@p)$ .= #BadArg"
   21.74 +  (* the read action with l visible *)
   21.75 +  ReadInner_def     "ReadInner ch mm rs p l ==
   21.76 +                         $(RdRequest ch p l)
   21.77 +                         .& (GoodRead mm rs p l  .|  BadRead mm rs p l)
   21.78 +                         .& unchanged (rtrner ch @ p)"
   21.79 +  (* the read action with l quantified *)
   21.80 +  Read_def          "Read ch mm rs p == REX l. ReadInner ch mm rs p l"
   21.81 +
   21.82 +  (* similar definitions for the write action *)
   21.83 +  GoodWrite_def     "GoodWrite mm rs p l v ==
   21.84 +                        #(MemLoc l) .& #(MemVal v) 
   21.85 +                        .& (mm@l)$ .= #v .& (rs@p)$ .= #OK"
   21.86 +  BadWrite_def      "BadWrite mm rs p l v ==
   21.87 +                        .~ (#(MemLoc l) .& #(MemVal v))
   21.88 +                        .& (rs@p)$ .= #BadArg .& unchanged (mm@l)"
   21.89 +  WriteInner_def    "WriteInner ch mm rs p l v ==
   21.90 +                        $(WrRequest ch p l v)
   21.91 +                        .& (GoodWrite mm rs p l v  .|  BadWrite mm rs p l v)
   21.92 +                        .& unchanged (rtrner ch @ p)"
   21.93 +  Write_def         "Write ch mm rs p l == REX v. WriteInner ch mm rs p l v"
   21.94 +
   21.95 +  (* the return action *)
   21.96 +  MemReturn_def     "MemReturn ch rs p ==
   21.97 +                        $(rs@p) .~= #NotAResult
   21.98 +                        .& (rs@p)$ .= #NotAResult
   21.99 +                        .& Return ch p ($(rs@p))"
  21.100 +  (* the failure action of the unreliable memory *)
  21.101 +  MemFail_def       "MemFail ch rs p ==
  21.102 +                        $(Calling ch p)
  21.103 +                        .& (rs@p)$ .= #MemFailure
  21.104 +                        .& unchanged (rtrner ch @ p)"
  21.105 +  RNext_def         "RNext ch mm rs p ==
  21.106 +                        Read ch mm rs p
  21.107 +                        .| (REX l. Write ch mm rs p l)
  21.108 +                        .| MemReturn ch rs p"
  21.109 +  UNext_def         "UNext ch mm rs p ==
  21.110 +                        RNext ch mm rs p .| MemFail ch rs p"
  21.111 +
  21.112 +  RPSpec_def        "RPSpec ch mm rs p ==
  21.113 +                        Init($(PInit rs p))
  21.114 +                        .& [][ RNext ch mm rs p ]_<rtrner ch @ p, rs@p>
  21.115 +                        .& WF(RNext ch mm rs p)_<rtrner ch @ p, rs@p>
  21.116 +                        .& WF(MemReturn ch rs p)_<rtrner ch @ p, rs@p>"
  21.117 +  UPSpec_def        "UPSpec ch mm rs p ==
  21.118 +                        Init($(PInit rs p))
  21.119 +                        .& [][ UNext ch mm rs p ]_<rtrner ch @ p, rs@p>
  21.120 +                        .& WF(RNext ch mm rs p)_<rtrner ch @ p, rs@p>
  21.121 +                        .& WF(MemReturn ch rs p)_<rtrner ch @ p, rs@p>"
  21.122 +  MSpec_def         "MSpec ch mm rs l ==
  21.123 +                        Init($(MInit mm l))
  21.124 +                        .& [][ REX p. Write ch mm rs p l ]_(mm@l)"
  21.125 +  IRSpec_def        "IRSpec ch mm rs ==
  21.126 +                        (RALL p. RPSpec ch mm rs p)
  21.127 +                        .& (RALL l. #(MemLoc l) .-> MSpec ch mm rs l)"
  21.128 +  IUSpec_def        "IUSpec ch mm rs ==
  21.129 +                        (RALL p. UPSpec ch mm rs p)
  21.130 +                        .& (RALL l. #(MemLoc l) .-> MSpec ch mm rs l)"
  21.131 +
  21.132 +  RSpec_def         "RSpec ch rs == EEX mm. IRSpec ch mm rs"
  21.133 +  USpec_def         "USpec ch == EEX mm rs. IUSpec ch mm rs"
  21.134 +
  21.135 +  MemInv_def        "$(MemInv mm l) .=
  21.136 +                        (#(MemLoc l) .-> MemVal[ $(mm@l)])"
  21.137 +end
  21.138 +
  21.139 +
  21.140 +
    22.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    22.2 +++ b/src/HOL/TLA/Memory/MemoryImplementation.ML	Wed Oct 08 11:50:33 1997 +0200
    22.3 @@ -0,0 +1,672 @@
    22.4 +(* 
    22.5 +    File:        MemoryImplementation.ML
    22.6 +    Author:      Stephan Merz
    22.7 +    Copyright:   1997 University of Munich
    22.8 +
    22.9 +    RPC-Memory example: Memory implementation (ML file)
   22.10 +
   22.11 +    The main theorem is theorem "Implementation" at the end of this file,
   22.12 +    which shows that the composition of a reliable memory, an RPC component, and
   22.13 +    a memory clerk implements an unreliable memory. The files "MIsafe.ML" and
   22.14 +    "MIlive.ML" contain lower-level lemmas for the safety and liveness parts.
   22.15 +
   22.16 +    Steps are (roughly) numbered as in the hand proof.
   22.17 +*)
   22.18 +
   22.19 +
   22.20 +(* ------------------------------ HOL lemmas ------------------------------ *)
   22.21 +(* Add the following simple lemmas as default simplification rules. *)
   22.22 +
   22.23 +section "Auxiliary lemmas";
   22.24 +
   22.25 +qed_goal "equal_false_not" HOL.thy "(P = False) = (~P)"
   22.26 +   (fn _ => [fast_tac prop_cs 1]);
   22.27 +
   22.28 +Addsimps [equal_false_not];
   22.29 +
   22.30 +
   22.31 +(* A variant of the implication elimination rule that keeps the antecedent.
   22.32 +   Use "thm RS impdupE" to generate an unsafe (looping) elimination rule. 
   22.33 +*)
   22.34 +
   22.35 +qed_goal "impdupE" HOL.thy
   22.36 +   "[| P --> Q; P; [| P;Q |] ==> R |] ==> R"
   22.37 +   (fn maj::prems => [REPEAT (resolve_tac ([maj RS mp] @ prems) 1)]);
   22.38 +
   22.39 +
   22.40 +(* Introduction/elimination rules for if-then-else *)
   22.41 +
   22.42 +qed_goal "ifI" HOL.thy 
   22.43 +   "[| Q ==> P(x); ~Q ==> P(y) |] ==> P(if Q then x else y)"
   22.44 +   (fn prems => [case_tac "Q" 1, ALLGOALS (Asm_simp_tac THEN' (eresolve_tac prems))]);
   22.45 +
   22.46 +qed_goal "ifE" HOL.thy
   22.47 +   "[| P(if Q then x else y); [| Q; P(x) |] ==> R; [| ~Q; P(y) |] ==> R |] ==> R"
   22.48 +   (fn (prem1::prems) => [case_tac "Q" 1,
   22.49 +                          ALLGOALS ((cut_facts_tac [prem1])
   22.50 +                                    THEN' Asm_full_simp_tac 
   22.51 +                                    THEN' (REPEAT o ((eresolve_tac prems) ORELSE' atac)))
   22.52 +                         ]);
   22.53 +
   22.54 +(* --------------------------- automatic prover --------------------------- *)
   22.55 +(* Set up a clasimpset that contains data-level simplifications. *)
   22.56 +
   22.57 +val MI_css = temp_css addsimps2 (CP_simps @ histState.simps
   22.58 +                                 @ [slice_def,equal_false_not,if_cancel,sum_case_Inl, sum_case_Inr]);
   22.59 +
   22.60 +(* A more aggressive variant that tries to solve subgoals by assumption
   22.61 +   or contradiction during the simplification.
   22.62 +   THIS IS UNSAFE, BECAUSE IT DOESN'T RECORD THE CHOICES!!
   22.63 +   (but sometimes a lot faster than MI_css)
   22.64 +*)
   22.65 +val MI_fast_css =
   22.66 +  let 
   22.67 +    val (cs,ss) = MI_css
   22.68 +  in
   22.69 +    (cs, ss addSSolver (fn thms => assume_tac ORELSE' (etac notE)))
   22.70 +end;
   22.71 +
   22.72 +(* Make sure the simpset accepts non-boolean simplifications *)
   22.73 +simpset := let val (_,ss) = MI_css in ss end;
   22.74 +
   22.75 +
   22.76 +(****************************** The history variable ******************************)
   22.77 +section "History variable";
   22.78 +
   22.79 +qed_goal "HistoryLemma" MemoryImplementation.thy
   22.80 +   "Init(RALL p. $(ImpInit p)) .& [](RALL p. ImpNext p)  \
   22.81 +\   .-> (EEX rmhist.    Init(RALL p. $(HInit rmhist p)) \
   22.82 +\                    .& [](RALL p. [HNext rmhist p]_<c p, r p, m p, rmhist@p>))"
   22.83 +   (fn _ => [Auto_tac(),
   22.84 +             rtac historyI 1, TRYALL atac,
   22.85 +             action_simp_tac (!simpset addsimps [HInit_def]) [] [] 1,
   22.86 +             res_inst_tac [("x","p")] fun_cong 1, atac 1,
   22.87 +             action_simp_tac (!simpset addsimps [HNext_def]) [busy_squareI] [] 1,
   22.88 +             res_inst_tac [("x","p")] fun_cong 1, atac 1
   22.89 +            ]);
   22.90 +
   22.91 +qed_goal "History" MemoryImplementation.thy
   22.92 +   "Implementation .-> (EEX rmhist. Hist rmhist)"
   22.93 +   (fn _ => [Auto_tac(),
   22.94 +             rtac ((temp_mp HistoryLemma) RS eex_mono) 1,
   22.95 +             SELECT_GOAL 
   22.96 +               (auto_tac (MI_css 
   22.97 +                          addsimps2 [Impl_def,MClkISpec_def,RPCISpec_def,IRSpec_def,
   22.98 +                                     MClkIPSpec_def,RPCIPSpec_def,RPSpec_def,
   22.99 +                                     ImpInit_def,Init_def,ImpNext_def,
  22.100 +                                     c_def,r_def,m_def,all_box,split_box_conj])) 1,
  22.101 +             auto_tac (MI_css 
  22.102 +                       addsimps2 [Hist_def,HistP_def,Init_def,all_box,split_box_conj])
  22.103 +            ]);
  22.104 +
  22.105 +(******************************** The safety part *********************************)
  22.106 +
  22.107 +section "The safety part";
  22.108 +
  22.109 +(* ------------------------- Include lower-level lemmas ------------------------- *)
  22.110 +use "MIsafe.ML";
  22.111 +
  22.112 +section "Correctness of predicate-action diagram";
  22.113 +
  22.114 +(* ========== Step 1.1 ================================================= *)
  22.115 +(* The implementation's initial condition implies the state predicate S1 *)
  22.116 +
  22.117 +qed_goal "Step1_1" MemoryImplementation.thy
  22.118 +   "$(ImpInit p) .& $(HInit rmhist p) .-> $(S1 rmhist p)"
  22.119 +   (fn _ => [auto_tac (MI_fast_css
  22.120 +		       addsimps2 [MVNROKBA_def,MClkInit_def,RPCInit_def,PInit_def,
  22.121 +			          HInit_def,ImpInit_def,S_def,S1_def])
  22.122 +	    ]);
  22.123 +
  22.124 +(* ========== Step 1.2 ================================================== *)
  22.125 +(* Figure 16 is a predicate-action diagram for the implementation. *)
  22.126 +
  22.127 +qed_goal "Step1_2_1" MemoryImplementation.thy
  22.128 +   "[HNext rmhist p]_<c p,r p,m p, rmhist@p> .& ImpNext p  \
  22.129 +\             .& .~ unchanged <e p, c p, r p, m p, rmhist@p>  .& $(S1 rmhist p) \
  22.130 +\   .-> (S2 rmhist p)$ .& (ENext p) .& unchanged <c p, r p, m p>"
  22.131 +   (fn _ => [auto_tac (MI_css addsimps2 [ImpNext_def]
  22.132 +		              addSEs2 [S1ClerkUnchE,S1RPCUnchE,S1MemUnchE,S1HistE]),
  22.133 +	     ALLGOALS (action_simp_tac (!simpset addsimps [square_def]) [] [S1EnvE])
  22.134 +	    ]);
  22.135 +
  22.136 +qed_goal "Step1_2_2" MemoryImplementation.thy
  22.137 +   "[HNext rmhist p]_<c p,r p,m p, rmhist@p> .& ImpNext p  \
  22.138 +\             .& .~ unchanged <e p, c p, r p, m p, rmhist@p>  .& $(S2 rmhist p) \
  22.139 +\   .-> (S3 rmhist p)$ .& (MClkFwd memCh crCh cst p) .& unchanged <e p, r p, m p, rmhist@p>"
  22.140 +   (fn _ => [auto_tac (MI_css addsimps2 [ImpNext_def]
  22.141 +		              addSEs2 [S2EnvUnchE,S2RPCUnchE,S2MemUnchE,S2HistE]),
  22.142 +	     ALLGOALS (action_simp_tac (!simpset addsimps [square_def]) [] [S2ClerkE,S2ForwardE])
  22.143 +	    ]);
  22.144 +
  22.145 +qed_goal "Step1_2_3" MemoryImplementation.thy
  22.146 +   "[HNext rmhist p]_<c p,r p,m p, rmhist@p> .& ImpNext p  \
  22.147 +\             .& .~ unchanged <e p, c p, r p, m p, rmhist@p>  .& $(S3 rmhist p) \
  22.148 +\   .-> ((S4 rmhist p)$ .& RPCFwd crCh rmCh rst p .& unchanged <e p, c p, m p, rmhist@p>) \
  22.149 +\        .| ((S6 rmhist p)$ .& RPCFail crCh rmCh rst p .& unchanged <e p, c p, m p>)"
  22.150 +   (fn _ => [action_simp_tac (!simpset addsimps [ImpNext_def])
  22.151 +	                     [] [S3EnvUnchE,S3ClerkUnchE,S3MemUnchE] 1,
  22.152 +             ALLGOALS (action_simp_tac (!simpset addsimps [square_def])
  22.153 +		                       [] [S3RPCE,S3ForwardE,S3FailE]),
  22.154 +             auto_tac (MI_css addEs2 [S3HistE])
  22.155 +	    ]);
  22.156 +
  22.157 +qed_goal "Step1_2_4" MemoryImplementation.thy
  22.158 +   "[HNext rmhist p]_<c p,r p,m p, rmhist@p> .& ImpNext p  \
  22.159 +\             .& .~ unchanged <e p, c p, r p, m p, rmhist@p> \
  22.160 +\             .& $(S4 rmhist p) .& (RALL l. $(MemInv mem l))     \
  22.161 +\   .-> ((S4 rmhist p)$ .& Read rmCh mem ires p .& unchanged <e p, c p, r p, rmhist@p>) \
  22.162 +\        .| ((S4 rmhist p)$ .& (REX l. Write rmCh mem ires p l) .& unchanged <e p, c p, r p, rmhist@p>) \
  22.163 +\        .| ((S5 rmhist p)$ .& MemReturn rmCh ires p .& unchanged <e p, c p, r p>)"
  22.164 +   (fn _ => [action_simp_tac (!simpset addsimps [ImpNext_def]) 
  22.165 +                             [] [S4EnvUnchE,S4ClerkUnchE,S4RPCUnchE] 1,
  22.166 +             ALLGOALS (action_simp_tac (!simpset addsimps [square_def,RNext_def])
  22.167 +                                       [] [S4ReadE,S4WriteE,S4ReturnE]),
  22.168 +             auto_tac (MI_css addEs2 [S4HistE])
  22.169 +            ]);
  22.170 +
  22.171 +qed_goal "Step1_2_5" MemoryImplementation.thy
  22.172 +   "[HNext rmhist p]_<c p,r p,m p, rmhist@p> .& ImpNext p  \
  22.173 +\             .& .~ unchanged <e p, c p, r p, m p, rmhist@p>  .& $(S5 rmhist p) \
  22.174 +\   .-> ((S6 rmhist p)$ .& RPCReply crCh rmCh rst p .& unchanged <e p, c p, m p>) \
  22.175 +\        .| ((S6 rmhist p)$ .& RPCFail crCh rmCh rst p .& unchanged <e p, c p, m p>)"
  22.176 +   (fn _ => [action_simp_tac (!simpset addsimps [ImpNext_def]) 
  22.177 +                             [] [S5EnvUnchE,S5ClerkUnchE,S5MemUnchE,S5HistE] 1,
  22.178 +	     action_simp_tac (!simpset addsimps [square_def]) [] [S5RPCE] 1,
  22.179 +	     auto_tac (MI_fast_css addSEs2 [S5ReplyE,S5FailE])
  22.180 +	    ]);
  22.181 +
  22.182 +qed_goal "Step1_2_6" MemoryImplementation.thy
  22.183 +   "[HNext rmhist p]_<c p,r p,m p, rmhist@p> .& ImpNext p  \
  22.184 +\             .& .~ unchanged <e p, c p, r p, m p, rmhist@p>  .& $(S6 rmhist p) \
  22.185 +\   .-> ((S1 rmhist p)$ .& (MClkReply memCh crCh cst p) .& unchanged <e p, r p, m p>)\
  22.186 +\        .| ((S3 rmhist p)$ .& (MClkRetry memCh crCh cst p) .& unchanged <e p,r p,m p,rmhist@p>)"
  22.187 +   (fn _ => [action_simp_tac (!simpset addsimps [ImpNext_def]) 
  22.188 +                             [] [S6EnvUnchE,S6RPCUnchE,S6MemUnchE] 1,
  22.189 +             ALLGOALS (action_simp_tac (!simpset addsimps [square_def]) 
  22.190 +                                       [] [S6ClerkE,S6RetryE,S6ReplyE]),
  22.191 +             auto_tac (MI_css addEs2 [S6HistE])
  22.192 +            ]);
  22.193 +
  22.194 +
  22.195 +(* --------------------------------------------------------------------------
  22.196 +   Step 1.3: S1 implies the barred initial condition.
  22.197 +*)
  22.198 +
  22.199 +section "Initialization (Step 1.3)";
  22.200 +
  22.201 +val resbar_unl = rewrite_rule [slice_def] (action_unlift resbar_def);
  22.202 +
  22.203 +qed_goal "Step1_3" MemoryImplementation.thy 
  22.204 +   "$(S1 rmhist p) .-> $(PInit (resbar rmhist) p)"
  22.205 +   (fn _ => [action_simp_tac (!simpset addsimps [resbar_unl,PInit_def,S_def,S1_def])
  22.206 +                             [] [] 1
  22.207 +            ]);
  22.208 +
  22.209 +(* ----------------------------------------------------------------------
  22.210 +   Step 1.4: Implementation's next-state relation simulates specification's
  22.211 +             next-state relation (with appropriate substitutions)
  22.212 +*)
  22.213 +
  22.214 +section "Step simulation (Step 1.4)";
  22.215 +
  22.216 +qed_goal "Step1_4_1" MemoryImplementation.thy
  22.217 +   "ENext p .& $(S1 rmhist p) .& (S2 rmhist p)$ .& unchanged <c p, r p, m p> \
  22.218 +\   .-> unchanged <rtrner memCh @ p, resbar rmhist @ p>"
  22.219 +  (fn _ => [ auto_tac (MI_fast_css addsimps2 [c_def,r_def,m_def,resbar_unl]) ]);
  22.220 +
  22.221 +qed_goal "Step1_4_2" MemoryImplementation.thy
  22.222 +   "MClkFwd memCh crCh cst p .& $(S2 rmhist p) .& (S3 rmhist p)$  \
  22.223 +\                            .& unchanged <e p, r p, m p, rmhist@p> \
  22.224 +\   .-> unchanged <rtrner memCh @ p, resbar rmhist @ p>"
  22.225 +  (fn _ => [auto_tac (MI_fast_css 
  22.226 +                      addsimps2 [MClkFwd_def, e_def, r_def, m_def, resbar_unl,
  22.227 +                                 S_def, S2_def, S3_def])
  22.228 +           ]);
  22.229 +
  22.230 +qed_goal "Step1_4_3a" MemoryImplementation.thy
  22.231 +   "RPCFwd crCh rmCh rst p .& $(S3 rmhist p) .& (S4 rmhist p)$    \
  22.232 +\                          .& unchanged <e p, c p, m p, rmhist@p> \
  22.233 +\   .-> unchanged <rtrner memCh @ p, resbar rmhist @ p>"
  22.234 +  (fn _ => [auto_tac (MI_fast_css addsimps2 [e_def,c_def,m_def,resbar_unl]),
  22.235 +	      (* NB: Adding S3_exclE,S4_exclE as safe elims above would loop,
  22.236 +                     adding them as unsafe elims doesn't help, 
  22.237 +                     because auto_tac doesn't find the proof! *)
  22.238 +            REPEAT (eresolve_tac [S3_exclE,S4_exclE] 1),
  22.239 +            action_simp_tac (!simpset addsimps [S_def, S3_def]) [] [] 1
  22.240 +           ]);
  22.241 +
  22.242 +qed_goal "Step1_4_3b" MemoryImplementation.thy
  22.243 +   "RPCFail crCh rmCh rst p .& $(S3 rmhist p) .& (S6 rmhist p)$ .& unchanged <e p, c p, m p>\
  22.244 +\   .-> MemFail memCh (resbar rmhist) p"
  22.245 +  (fn _ => [auto_tac (MI_css addsimps2 [RPCFail_def,MemFail_def,e_def,c_def,m_def,
  22.246 +		                        resbar_unl]),
  22.247 +	        (* It's faster not to expand S3 at once *)
  22.248 +            action_simp_tac (!simpset addsimps [S3_def,S_def]) [] [] 1,
  22.249 +            etac S6_exclE 1,
  22.250 +            auto_tac (MI_fast_css addsimps2 [Return_def])
  22.251 +           ]);
  22.252 +
  22.253 +
  22.254 +qed_goal "Step1_4_4a1" MemoryImplementation.thy
  22.255 +   "$(S4 rmhist p) .& (S4 rmhist p)$ .& ReadInner rmCh mem ires p l \
  22.256 +\   .& unchanged <e p, c p, r p, rmhist@p> .& $(MemInv mem l) \
  22.257 +\   .-> ReadInner memCh mem (resbar rmhist) p l"
  22.258 +  (fn _ => [action_simp_tac 
  22.259 +               (!simpset addsimps [ReadInner_def,GoodRead_def,BadRead_def,e_def,c_def,m_def]) 
  22.260 +               [] [] 1,
  22.261 +            ALLGOALS (REPEAT o (etac S4_exclE)),
  22.262 +            auto_tac (MI_css addsimps2 [resbar_unl]),
  22.263 +	    ALLGOALS (action_simp_tac 
  22.264 +                        (!simpset addsimps [RPCRelayArg_def,MClkRelayArg_def,
  22.265 +		                            S_def,S4_def,RdRequest_def,MemInv_def])
  22.266 +		      [] [impE,MemValNotAResultE])
  22.267 +           ]);
  22.268 +
  22.269 +qed_goal "Step1_4_4a" MemoryImplementation.thy
  22.270 +   "Read rmCh mem ires p .& $(S4 rmhist p) .& (S4 rmhist p)$ \
  22.271 +\   .& unchanged <e p, c p, r p, rmhist@p> .& (RALL l. $(MemInv mem l)) \
  22.272 +\   .-> Read memCh mem (resbar rmhist) p"
  22.273 +  (fn _ => [ auto_tac (MI_css addsimps2 [Read_def] addSIs2 [action_mp Step1_4_4a1]) ]);
  22.274 +
  22.275 +qed_goal "Step1_4_4b1" MemoryImplementation.thy
  22.276 +   "$(S4 rmhist p) .& (S4 rmhist p)$ .& WriteInner rmCh mem ires p l v   \
  22.277 +\                                    .& unchanged <e p, c p, r p, rmhist@p> \
  22.278 +\   .-> WriteInner memCh mem (resbar rmhist) p l v"
  22.279 +  (fn _ => [action_simp_tac 
  22.280 +               (!simpset addsimps [WriteInner_def, GoodWrite_def, BadWrite_def,
  22.281 +			           e_def, c_def, m_def])
  22.282 +               [] [] 1,
  22.283 +            ALLGOALS (REPEAT o (etac S4_exclE)),
  22.284 +	    auto_tac (MI_css addsimps2 [resbar_unl]),
  22.285 +               (* it's faster not to merge the two simplifications *)
  22.286 +	    ALLGOALS (action_simp_tac
  22.287 +                        (!simpset addsimps [RPCRelayArg_def,MClkRelayArg_def,
  22.288 +		                            S_def,S4_def,WrRequest_def])
  22.289 +		      [] [])
  22.290 +           ]);
  22.291 +
  22.292 +qed_goal "Step1_4_4b" MemoryImplementation.thy
  22.293 +   "Write rmCh mem ires p l .& $(S4 rmhist p) .& (S4 rmhist p)$   \
  22.294 +\                           .& unchanged <e p, c p, r p, rmhist@p> \
  22.295 +\   .-> Write memCh mem (resbar rmhist) p l"
  22.296 +  (fn _ => [ auto_tac (MI_css addsimps2 [Write_def] addSIs2 [action_mp Step1_4_4b1]) ]);
  22.297 +
  22.298 +qed_goal "Step1_4_4c" MemoryImplementation.thy
  22.299 +   "MemReturn rmCh ires p .& $(S4 rmhist p) .& (S5 rmhist p)$ .& unchanged <e p, c p, r p> \
  22.300 +\   .-> unchanged <rtrner memCh @ p, resbar rmhist @ p>"
  22.301 +  (fn _ => [action_simp_tac
  22.302 +	       (!simpset addsimps [e_def,c_def,r_def,resbar_unl]) [] [] 1,
  22.303 +	    REPEAT (eresolve_tac [S4_exclE,S5_exclE] 1),
  22.304 +	    auto_tac (MI_fast_css addsimps2 [MemReturn_def,Return_def])
  22.305 +           ]);
  22.306 +
  22.307 +qed_goal "Step1_4_5a" MemoryImplementation.thy
  22.308 +   "RPCReply crCh rmCh rst p .& $(S5 rmhist p) .& (S6 rmhist p)$ .& unchanged <e p, c p, m p> \
  22.309 +\   .-> unchanged <rtrner memCh @ p, resbar rmhist @ p>"
  22.310 +  (fn _ => [auto_tac (MI_css addsimps2 [e_def,c_def,m_def, resbar_unl]),
  22.311 +            REPEAT (eresolve_tac [S5_exclE,S6_exclE] 1),
  22.312 +	    auto_tac (MI_css addsimps2 [RPCReply_def,Return_def,S5_def,S_def]
  22.313 +		             addSEs2 [MVOKBAnotRFE])
  22.314 +           ]);
  22.315 +
  22.316 +qed_goal "Step1_4_5b" MemoryImplementation.thy
  22.317 +   "RPCFail crCh rmCh rst p .& $(S5 rmhist p) .& (S6 rmhist p)$ .& unchanged <e p, c p, m p>\
  22.318 +\   .-> MemFail memCh (resbar rmhist) p"
  22.319 +  (fn _ => [action_simp_tac
  22.320 +	       (!simpset addsimps [e_def, c_def, m_def, RPCFail_def, Return_def,
  22.321 +				   MemFail_def, resbar_unl])
  22.322 +	       [] [] 1,
  22.323 +	    action_simp_tac (!simpset addsimps [S5_def,S_def]) [] [] 1,
  22.324 +            etac S6_exclE 1,
  22.325 +	    auto_tac MI_css
  22.326 +           ]);
  22.327 +
  22.328 +qed_goal "Step1_4_6a" MemoryImplementation.thy
  22.329 +   "MClkReply memCh crCh cst p .& $(S6 rmhist p) .& (S1 rmhist p)$ .& unchanged <e p, r p, m p> \
  22.330 +\   .-> MemReturn memCh (resbar rmhist) p"
  22.331 +  (fn _ => [action_simp_tac
  22.332 +	      (!simpset addsimps [e_def, r_def, m_def, MClkReply_def, MemReturn_def,
  22.333 +				  Return_def, resbar_unl]) 
  22.334 +              [] [] 1,
  22.335 +            ALLGOALS (etac S6_exclE),
  22.336 +	    ALLGOALS Asm_full_simp_tac,  (* simplify if-then-else *)
  22.337 +	    ALLGOALS (action_simp_tac
  22.338 +    	              (!simpset addsimps [MClkReplyVal_def,S6_def,S_def])
  22.339 +		      [] []),
  22.340 +            rtac ifI 1,
  22.341 +            ALLGOALS (action_simp_tac (!simpset) [] [MVOKBARFnotNRE])
  22.342 +           ]);
  22.343 +
  22.344 +qed_goal "Step1_4_6b" MemoryImplementation.thy
  22.345 +   "MClkRetry memCh crCh cst p .& $(S6 rmhist p) .& (S3 rmhist p)$   \
  22.346 +\                              .& unchanged <e p, r p, m p, rmhist@p> \
  22.347 +\   .-> MemFail memCh (resbar rmhist) p"
  22.348 +  (fn _ => [action_simp_tac
  22.349 +	       (!simpset addsimps [e_def, r_def, m_def, MClkRetry_def, MemFail_def, resbar_unl])
  22.350 +	       [] [] 1,
  22.351 +	    SELECT_GOAL (auto_tac (MI_css addsimps2 [S6_def,S_def])) 1,
  22.352 +            etac S3_exclE 1,
  22.353 +            Asm_full_simp_tac 1,
  22.354 +	    action_simp_tac (!simpset addsimps [S6_def,S3_def,S_def]) [] [] 1
  22.355 +           ]);
  22.356 +
  22.357 +qed_goal "S_lemma" MemoryImplementation.thy
  22.358 +   "unchanged <e p, c p, r p, m p, rmhist@p> \
  22.359 +\   .-> unchanged (S rmhist ec cc rc cs rs hs1 hs2 p)"
  22.360 +   (fn _ => [auto_tac (MI_css addsimps2 [e_def,c_def,r_def,m_def,caller_def,rtrner_def,
  22.361 +					 S_def,Calling_def])
  22.362 +            ]);
  22.363 +
  22.364 +qed_goal "Step1_4_7H" MemoryImplementation.thy
  22.365 +   "unchanged <e p, c p, r p, m p, rmhist@p> \
  22.366 +\   .-> unchanged <rtrner memCh @ p, S1 rmhist p, S2 rmhist p, S3 rmhist p, \
  22.367 +\                                    S4 rmhist p, S5 rmhist p, S6 rmhist p>"
  22.368 +   (fn _ => [Action_simp_tac 1,
  22.369 +	     SELECT_GOAL (auto_tac (MI_fast_css addsimps2 [c_def])) 1,
  22.370 +             ALLGOALS (simp_tac (!simpset
  22.371 +				 addsimps [S1_def,S2_def,S3_def,S4_def,S5_def,S6_def])),
  22.372 +	     auto_tac (MI_css addSIs2 [action_mp S_lemma])
  22.373 +            ]);
  22.374 +
  22.375 +(* unlifted version as elimination rule *)
  22.376 +bind_thm("Step1_4_7h",
  22.377 +	 (rewrite_rule action_rews (Step1_4_7H RS actionD)) RS impdupE);
  22.378 +
  22.379 +qed_goal "Step1_4_7" MemoryImplementation.thy
  22.380 +   "unchanged <e p, c p, r p, m p, rmhist@p> .-> unchanged <rtrner memCh @ p, resbar rmhist @ p>"
  22.381 +  (fn _ => [rtac actionI 1,
  22.382 +            rewrite_goals_tac action_rews,
  22.383 +            rtac impI 1,
  22.384 +            etac Step1_4_7h 1,
  22.385 +	    auto_tac (MI_css addsimps2 [e_def,c_def,r_def,m_def,rtrner_def,resbar_unl])
  22.386 +           ]);
  22.387 +
  22.388 +
  22.389 +(* Frequently needed abbreviation: distinguish between idling and non-idling
  22.390 +   steps of the implementation, and try to solve the idling case by simplification
  22.391 +*)
  22.392 +fun split_idle_tac simps i = 
  22.393 +    EVERY [rtac actionI i,
  22.394 +	   case_tac "(unchanged <e p, c p, r p, m p, rmhist@p>) [[s,t]]" i,
  22.395 +	   rewrite_goals_tac action_rews,
  22.396 +	   etac Step1_4_7h i,
  22.397 +	   asm_full_simp_tac (!simpset addsimps simps) i
  22.398 +	  ];
  22.399 +
  22.400 +(* ----------------------------------------------------------------------
  22.401 +   Combine steps 1.2 and 1.4 to prove that the implementation satisfies
  22.402 +   the specification's next-state relation.
  22.403 +*)
  22.404 +
  22.405 +(* Steps that leave all variables unchanged are safe, so I may assume
  22.406 +   that some variable changes in the proof that a step is safe. *)
  22.407 +qed_goal "unchanged_safe" MemoryImplementation.thy
  22.408 +   "(.~ (unchanged <e p, c p, r p, m p, rmhist@p>) \
  22.409 +\      .-> [UNext memCh mem (resbar rmhist) p]_<rtrner memCh @ p, resbar rmhist @ p>) \
  22.410 +\   .-> [UNext memCh mem (resbar rmhist) p]_<rtrner memCh @ p, resbar rmhist @ p>"
  22.411 +   (fn _ => [rtac actionI 1,
  22.412 +             case_tac "(unchanged <e p, c p, r p, m p, rmhist@p>) [[s,t]]" 1,
  22.413 +	     rewrite_goals_tac action_rews,
  22.414 +	     auto_tac (MI_css addsimps2 [square_def] addSEs2 [action_impE Step1_4_7])
  22.415 +            ]);
  22.416 +(* turn into (unsafe, looping!) introduction rule *)
  22.417 +bind_thm("unchanged_safeI", impI RS (action_mp unchanged_safe));
  22.418 +
  22.419 +qed_goal "S1safe" MemoryImplementation.thy
  22.420 +   "$(S1 rmhist p) .& ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>   \
  22.421 +\  .-> [UNext memCh mem (resbar rmhist) p]_<rtrner memCh @ p, resbar rmhist @ p>"
  22.422 +   (fn _ => [Action_simp_tac 1, 
  22.423 +             rtac unchanged_safeI 1,
  22.424 +             rtac idle_squareI 1,
  22.425 +	     auto_tac (MI_css addSEs2 (map action_conjimpE [Step1_2_1,Step1_4_1]))
  22.426 +	    ]);
  22.427 +
  22.428 +qed_goal "S2safe" MemoryImplementation.thy
  22.429 +   "$(S2 rmhist p) .& ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>   \
  22.430 +\  .-> [UNext memCh mem (resbar rmhist) p]_<rtrner memCh @ p, resbar rmhist @ p>"
  22.431 +   (fn _ => [Action_simp_tac 1, 
  22.432 +             rtac unchanged_safeI 1,
  22.433 +             rtac idle_squareI 1,
  22.434 +	     auto_tac (MI_fast_css addSEs2 (map action_conjimpE [Step1_2_2,Step1_4_2]))
  22.435 +	    ]);
  22.436 +
  22.437 +qed_goal "S3safe" MemoryImplementation.thy
  22.438 +   "$(S3 rmhist p) .& ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>   \
  22.439 +\  .-> [UNext memCh mem (resbar rmhist) p]_<rtrner memCh @ p, resbar rmhist @ p>"
  22.440 +   (fn _ => [Action_simp_tac 1,
  22.441 +	     rtac unchanged_safeI 1,
  22.442 +             auto_tac (MI_css addSEs2 [action_conjimpE Step1_2_3]),
  22.443 +	     auto_tac (MI_fast_css addsimps2 [square_def,UNext_def]
  22.444 +		              addSEs2 (map action_conjimpE [Step1_4_3a,Step1_4_3b]))
  22.445 +	    ]);
  22.446 +
  22.447 +qed_goal "S4safe" MemoryImplementation.thy
  22.448 +   "$(S4 rmhist p) .& ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>  \
  22.449 +\                  .& (RALL l. $(MemInv mem l)) \
  22.450 +\  .-> [UNext memCh mem (resbar rmhist) p]_<rtrner memCh @ p, resbar rmhist @ p>"
  22.451 +   (fn _ => [Action_simp_tac 1,
  22.452 +	     rtac unchanged_safeI 1,
  22.453 +             auto_tac (MI_css addSEs2 [action_conjimpE Step1_2_4]),
  22.454 +             ALLGOALS (action_simp_tac (!simpset addsimps [square_def,UNext_def,RNext_def]) [] []),
  22.455 +	     auto_tac (MI_fast_css addSEs2 (map action_conjimpE 
  22.456 +                                                [Step1_4_4a,Step1_4_4b,Step1_4_4c]))
  22.457 +	    ]);
  22.458 +
  22.459 +qed_goal "S5safe" MemoryImplementation.thy
  22.460 +   "$(S5 rmhist p) .& ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>  \
  22.461 +\  .-> [UNext memCh mem (resbar rmhist) p]_<rtrner memCh @ p, resbar rmhist @ p>"
  22.462 +   (fn _ => [Action_simp_tac 1,
  22.463 +	     rtac unchanged_safeI 1,
  22.464 +             auto_tac (MI_css addSEs2 [action_conjimpE Step1_2_5]),
  22.465 +	     auto_tac (MI_fast_css addsimps2 [square_def,UNext_def]
  22.466 +		              addSEs2 (map action_conjimpE [Step1_4_5a,Step1_4_5b]))
  22.467 +	    ]);
  22.468 +
  22.469 +qed_goal "S6safe" MemoryImplementation.thy
  22.470 +   "$(S6 rmhist p) .& ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>   \
  22.471 +\  .-> [UNext memCh mem (resbar rmhist) p]_<rtrner memCh @ p, resbar rmhist @ p>"
  22.472 +   (fn _ => [Action_simp_tac 1,
  22.473 +	     rtac unchanged_safeI 1,
  22.474 +             auto_tac (MI_css addSEs2 [action_conjimpE Step1_2_6]),
  22.475 +	     auto_tac (MI_fast_css addsimps2 [square_def,UNext_def,RNext_def]
  22.476 +		              addSEs2 (map action_conjimpE [Step1_4_6a,Step1_4_6b]))
  22.477 +	    ]);
  22.478 +
  22.479 +(* ----------------------------------------------------------------------
  22.480 +   Step 1.5: Temporal refinement proof, based on previous steps.
  22.481 +*)
  22.482 +
  22.483 +section "The liveness part";
  22.484 +
  22.485 +use "MIlive.ML";
  22.486 +
  22.487 +section "Refinement proof (step 1.5)";
  22.488 +
  22.489 +(* Prove invariants of the implementation:
  22.490 +   a. memory invariant
  22.491 +   b. "implementation invariant": always in states S1,...,S6
  22.492 +*)
  22.493 +qed_goal "Step1_5_1a" MemoryImplementation.thy 
  22.494 +   "IPImp p .-> (RALL l. []$(MemInv mem l))"
  22.495 +   (fn _ => [auto_tac (MI_css addsimps2 [IPImp_def]
  22.496 +			      addSIs2 [temp_mp MemoryInvariantAll])
  22.497 +	    ]);
  22.498 +bind_thm("MemInvI", (rewrite_rule intensional_rews (Step1_5_1a RS tempD)) RS impdupE);
  22.499 +
  22.500 +qed_goal "Step1_5_1b" MemoryImplementation.thy
  22.501 +   "   Init($(ImpInit p) .& $(HInit rmhist p)) .& [](ImpNext p) \
  22.502 +\         .& [][HNext rmhist p]_<c p, r p, m p, rmhist@p> .& [](RALL l. $(MemInv mem l)) \
  22.503 +\   .-> []($(ImpInv rmhist p))"
  22.504 +   (fn _ => [inv_tac MI_css 1,
  22.505 +	     auto_tac (MI_css
  22.506 +		       addsimps2 [Init_def, ImpInv_def]
  22.507 +		       addSEs2 [action_impE Step1_1]
  22.508 +		       addEs2 (map action_conjimpE
  22.509 +			           [S1_successors,S2_successors,S3_successors,
  22.510 +			            S4_successors,S5_successors,S6_successors]))
  22.511 +            ]);
  22.512 +bind_thm("ImpInvI", (rewrite_rule intensional_rews (Step1_5_1b RS tempD)) RS impdupE);
  22.513 +
  22.514 +(*** Initialization ***)
  22.515 +qed_goal "Step1_5_2a" MemoryImplementation.thy
  22.516 +   "Init($(ImpInit p) .& $(HInit rmhist p)) .-> Init($PInit (resbar rmhist) p)"
  22.517 +   (fn _ => [auto_tac (MI_css addsimps2 [Init_def]
  22.518 +                              addSIs2 (map action_mp [Step1_1,Step1_3]))
  22.519 +            ]);
  22.520 +
  22.521 +(*** step simulation ***)
  22.522 +qed_goal "Step1_5_2b" MemoryImplementation.thy
  22.523 +   "[](ImpNext p .& [HNext rmhist p]_<c p, r p, m p, rmhist@p>   \
  22.524 +\                .& $(ImpInv rmhist p) .& (RALL l. $(MemInv mem l)))   \
  22.525 +\   .-> [][UNext memCh mem (resbar rmhist) p]_<rtrner memCh @ p, resbar rmhist @ p>"
  22.526 +   (fn _ => [auto_tac (MI_fast_css 
  22.527 +                          addsimps2 [ImpInv_def] 
  22.528 +                          addSEs2 (STL4E::(map action_conjimpE
  22.529 +                                         [S1safe,S2safe,S3safe,S4safe,S5safe,S6safe])))
  22.530 +            ]);
  22.531 +
  22.532 +
  22.533 +(*** Liveness ***)
  22.534 +qed_goal "GoodImpl" MemoryImplementation.thy
  22.535 +   "IPImp p .& HistP rmhist p  \
  22.536 +\   .->   Init($(ImpInit p) .& $(HInit rmhist p))   \
  22.537 +\      .& [](ImpNext p .& [HNext rmhist p]_<c p, r p, m p, rmhist@p>) \
  22.538 +\      .& [](RALL l. $(MemInv mem l)) .& []($(ImpInv rmhist p)) \
  22.539 +\      .& ImpLive p"
  22.540 +   (fn _ => [(* need some subgoals to prove [](ImpInv p), avoid duplication *)
  22.541 +	     rtac tempI 1, rewrite_goals_tac intensional_rews, rtac impI 1,
  22.542 +             subgoal_tac
  22.543 +	       "sigma |= Init($(ImpInit p) .& $(HInit rmhist p)) \
  22.544 +\                        .& [](ImpNext p) \
  22.545 +\                        .& [][HNext rmhist p]_<c p, r p, m p, rmhist@p> \
  22.546 +\                        .& [](RALL l. $(MemInv mem l))" 1,
  22.547 +	     auto_tac (MI_css addsimps2 [split_box_conj]
  22.548 +                              addSEs2 [temp_conjimpE Step1_5_1b]),
  22.549 +	     SELECT_GOAL
  22.550 +	        (auto_tac (MI_css addsimps2 [IPImp_def,MClkIPSpec_def,RPCIPSpec_def,RPSpec_def,
  22.551 +					     ImpLive_def,c_def,r_def,m_def])) 1,
  22.552 +	     SELECT_GOAL
  22.553 +	        (auto_tac (MI_css addsimps2 [IPImp_def,MClkIPSpec_def,RPCIPSpec_def,RPSpec_def,
  22.554 +					     HistP_def,Init_def,action_unlift ImpInit_def])) 1,
  22.555 +	     SELECT_GOAL
  22.556 +	        (auto_tac (MI_css addsimps2 [IPImp_def,MClkIPSpec_def,RPCIPSpec_def,RPSpec_def,
  22.557 +					     ImpNext_def,c_def,r_def,m_def,
  22.558 +					     split_box_conj])) 1,
  22.559 +	     SELECT_GOAL (auto_tac (MI_css addsimps2 [HistP_def])) 1,
  22.560 +             etac ((temp_mp Step1_5_1a) RS ((temp_unlift allT) RS iffD1)) 1
  22.561 +	    ]);
  22.562 +
  22.563 +(* The implementation is infinitely often in state S1 *)
  22.564 +qed_goal "Step1_5_3a" MemoryImplementation.thy
  22.565 +   "[](ImpNext p .& [HNext rmhist p]_<c p, r p, m p, rmhist@p>) \
  22.566 +\   .& [](RALL l. $(MemInv mem l))  \
  22.567 +\   .& []($(ImpInv rmhist p)) .& ImpLive p  \
  22.568 +\   .-> []<>($(S1 rmhist p))"
  22.569 +   (fn _ => [auto_tac (MI_css addsimps2 [ImpLive_def]),
  22.570 +             rtac S1Infinite 1,
  22.571 +	     SELECT_GOAL
  22.572 +	       (auto_tac (MI_css
  22.573 +			  addsimps2 [split_box_conj]
  22.574 +			  addSIs2 (NotS1LeadstoS6::
  22.575 +				   map temp_mp [S2_live,S3_live,S4a_live,S4b_live,S5_live]))) 1,
  22.576 +             auto_tac (MI_css addsimps2 [split_box_conj] addSIs2 [temp_mp S6_live])
  22.577 +            ]);
  22.578 +
  22.579 +(* Hence, it satisfies the fairness requirements of the specification *)
  22.580 +qed_goal "Step1_5_3b" MemoryImplementation.thy
  22.581 +   "[](ImpNext p .& [HNext rmhist p]_<c p, r p, m p, rmhist@p>) \
  22.582 +\   .& [](RALL l. $(MemInv mem l)) .& []($(ImpInv rmhist p)) .& ImpLive p  \
  22.583 +\   .-> WF(RNext memCh mem (resbar rmhist) p)_<rtrner memCh @ p, resbar rmhist @ p>"
  22.584 +   (fn _ => [ auto_tac (MI_fast_css addSIs2 [RNext_fair,temp_mp Step1_5_3a]) ]);
  22.585 +
  22.586 +qed_goal "Step1_5_3c" MemoryImplementation.thy
  22.587 +   "[](ImpNext p .& [HNext rmhist p]_<c p, r p, m p, rmhist@p>) \
  22.588 +\   .& [](RALL l. $(MemInv mem l)) .& []($(ImpInv rmhist p)) .& ImpLive p  \
  22.589 +\   .-> WF(MemReturn memCh (resbar rmhist) p)_<rtrner memCh @ p, resbar rmhist @ p>"
  22.590 +   (fn _ => [ auto_tac (MI_fast_css addSIs2 [Return_fair,temp_mp Step1_5_3a]) ]);
  22.591 +
  22.592 +
  22.593 +(* QED step of step 1 *)
  22.594 +qed_goal "Step1" MemoryImplementation.thy
  22.595 +   "IPImp p .& HistP rmhist p .-> UPSpec memCh mem (resbar rmhist) p"
  22.596 +   (fn _ => [auto_tac
  22.597 +               (MI_css addsimps2 [UPSpec_def,split_box_conj]
  22.598 +		       addSEs2 [temp_impE GoodImpl]
  22.599 +                       addSIs2 (map temp_mp [Step1_5_2a,Step1_5_2b,
  22.600 +                                             Step1_5_3b,Step1_5_3c]))
  22.601 +            ]);
  22.602 +
  22.603 +
  22.604 +(* ------------------------------ Step 2 ------------------------------ *)
  22.605 +section "Step 2";
  22.606 +
  22.607 +qed_goal "Step2_2a" MemoryImplementation.thy
  22.608 +   "ImpNext p .& [HNext rmhist p]_<c p, r p, m p, rmhist@p> \
  22.609 +\   .& $(S4 rmhist p) .& Write rmCh mem ires p l \
  22.610 +\   .-> (S4 rmhist p)$ .& unchanged <e p, c p, r p, rmhist@p>"
  22.611 +   (fn _ => [split_idle_tac [] 1,
  22.612 +             action_simp_tac (!simpset addsimps [ImpNext_def])
  22.613 +                             [] [S4EnvUnchE,S4ClerkUnchE,S4RPCUnchE] 1,
  22.614 +             TRYALL (action_simp_tac (!simpset addsimps [square_def]) [] [S4WriteE]),
  22.615 +             Auto_tac()
  22.616 +            ]);
  22.617 +
  22.618 +qed_goal "Step2_2" MemoryImplementation.thy
  22.619 +   "      (RALL p. ImpNext p) \
  22.620 +\      .& (RALL p. [HNext rmhist p]_<c p, r p, m p, rmhist@p>) \
  22.621 +\      .& (RALL p. $(ImpInv rmhist p)) \
  22.622 +\      .& [REX q. Write rmCh mem ires q l]_(mem@l) \
  22.623 +\   .-> [REX q. Write memCh mem (resbar rmhist) q l]_(mem@l)"
  22.624 +   (fn _ => [auto_tac (MI_css addsimps2 [square_def]
  22.625 +                                   addSIs2 [action_mp Step1_4_4b]
  22.626 +		                   addSEs2 [WriteS4E, action_conjimpE Step2_2a])
  22.627 +            ]);
  22.628 +
  22.629 +qed_goal "Step2_lemma" MemoryImplementation.thy
  22.630 +   "    [](   (RALL p. ImpNext p) \
  22.631 +\          .& (RALL p. [HNext rmhist p]_<c p, r p, m p, rmhist@p>) \
  22.632 +\          .& (RALL p. $(ImpInv rmhist p)) \
  22.633 +\          .& [REX q. Write rmCh mem ires q l]_(mem@l)) \
  22.634 +\   .-> [][REX q. Write memCh mem (resbar rmhist) q l]_(mem@l)"
  22.635 +   (fn _ => [ auto_tac (MI_css addSEs2 [STL4E, action_conjimpE Step2_2]) ]);
  22.636 +
  22.637 +qed_goal "Step2" MemoryImplementation.thy
  22.638 +   "#(MemLoc l) .& (RALL p. IPImp p .& HistP rmhist p)  \
  22.639 +\   .-> MSpec memCh mem (resbar rmhist) l"
  22.640 +   (fn _ => [auto_tac (MI_css addsimps2 [MSpec_def]),
  22.641 +	         (* prove initial condition, don't expand IPImp in other subgoal *)
  22.642 +	     SELECT_GOAL (auto_tac (MI_css addsimps2 [IPImp_def,MSpec_def])) 1,
  22.643 +	     auto_tac (MI_css addSIs2 [temp_mp Step2_lemma]
  22.644 +		              addsimps2 [split_box_conj,all_box]),
  22.645 +	     SELECT_GOAL (auto_tac (MI_css addsimps2 [IPImp_def,MSpec_def])) 4,
  22.646 +             auto_tac (MI_css addsimps2 [split_box_conj]
  22.647 +			      addSEs2 [temp_impE GoodImpl])
  22.648 +	    ]);
  22.649 +
  22.650 +(* ----------------------------- Main theorem --------------------------------- *)
  22.651 +section "Memory implementation";
  22.652 +
  22.653 +(* The combination of a legal caller, the memory clerk, the RPC component,
  22.654 +   and a reliable memory implement the unreliable memory.
  22.655 +*)
  22.656 +
  22.657 +(* Implementation of internal specification by combination of implementation
  22.658 +   and history variable with explicit refinement mapping
  22.659 +*)
  22.660 +qed_goal "Impl_IUSpec" MemoryImplementation.thy
  22.661 +   "Implementation .& Hist rmhist .-> IUSpec memCh mem (resbar rmhist)"
  22.662 +   (fn _ => [auto_tac (MI_css addsimps2 [IUSpec_def,Impl_def,IPImp_def,MClkISpec_def,
  22.663 +					 RPCISpec_def,IRSpec_def,Hist_def]
  22.664 +		              addSIs2 (map temp_mp [Step1,Step2]))
  22.665 +	    ]);
  22.666 +
  22.667 +(* The main theorem: introduce hiding and eliminate history variable. *)
  22.668 +qed_goal "Implementation" MemoryImplementation.thy
  22.669 +   "Implementation .-> USpec memCh"
  22.670 +   (fn _ => [Auto_tac(),
  22.671 +             forward_tac [temp_mp History] 1,
  22.672 +             auto_tac (MI_css addsimps2 [USpec_def] 
  22.673 +                              addIs2 (map temp_mp [eexI, Impl_IUSpec])
  22.674 +                              addSEs2 [eexE])
  22.675 +            ]);
    23.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    23.2 +++ b/src/HOL/TLA/Memory/MemoryImplementation.thy	Wed Oct 08 11:50:33 1997 +0200
    23.3 @@ -0,0 +1,188 @@
    23.4 +(*
    23.5 +    File:        MemoryImplementation.thy
    23.6 +    Author:      Stephan Merz
    23.7 +    Copyright:   1997 University of Munich
    23.8 +
    23.9 +    Theory Name: MemoryImplementation
   23.10 +    Logic Image: TLA
   23.11 +
   23.12 +    RPC-Memory example: Memory implementation
   23.13 +*)
   23.14 +
   23.15 +MemoryImplementation = Memory + RPC + MemClerk + MIParameters +
   23.16 +
   23.17 +types
   23.18 +  histType  = "(PrIds => histState) stfun"     (* the type of the history variable *)
   23.19 +
   23.20 +consts
   23.21 +  (* the specification *)
   23.22 +     (* channel (external) *)
   23.23 +  memCh         :: "memChType"
   23.24 +     (* internal variables *)
   23.25 +  mem           :: "memType"
   23.26 +  resbar        :: "histType => resType"        (* defined by refinement mapping *)
   23.27 +  
   23.28 +  (* the state variables of the implementation *)
   23.29 +     (* channels *)
   23.30 +  (* same interface channel memCh *)
   23.31 +  crCh          :: "rpcSndChType"
   23.32 +  rmCh          :: "rpcRcvChType"
   23.33 +     (* internal variables *)
   23.34 +  (* identity refinement mapping for mem -- simply reused *)
   23.35 +  rst           :: "rpcStType"
   23.36 +  cst           :: "mClkStType"
   23.37 +  ires          :: "resType"
   23.38 +(* the history variable : not defined as a constant
   23.39 +  rmhist        :: "histType"
   23.40 +*)
   23.41 +
   23.42 +  (* the environment action *)
   23.43 +  ENext         :: "PrIds => action"
   23.44 +
   23.45 +  (* specification of the history variable *)
   23.46 +  HInit         :: "histType => PrIds => stpred"
   23.47 +  HNext         :: "histType => PrIds => action"
   23.48 +  HistP         :: "histType => PrIds => temporal"
   23.49 +  Hist          :: "histType => temporal"
   23.50 +
   23.51 +  (* the implementation *)
   23.52 +  ImpInit        :: "PrIds => stpred"
   23.53 +  ImpNext        :: "PrIds => action"
   23.54 +  ImpLive        :: "PrIds => temporal"
   23.55 +  IPImp          :: "PrIds => temporal"
   23.56 +  Implementation :: "temporal"
   23.57 +  ImpInv         :: "histType => PrIds => stpred"
   23.58 +
   23.59 +  (* tuples of state functions changed by the various components *)
   23.60 +  e             :: "PrIds => (bit * memArgType) stfun"
   23.61 +  c             :: "PrIds => (mClkState * (bit * Vals) * (bit * rpcArgType)) stfun"
   23.62 +  r             :: "PrIds => (rpcState * (bit * Vals) * (bit * memArgType)) stfun"
   23.63 +  m             :: "PrIds => ((bit * Vals) * Vals) stfun"
   23.64 +
   23.65 +  (* the predicate S describes the states of the implementation.
   23.66 +     slight simplification: two "histState" parameters instead of a (one- or
   23.67 +     two-element) set. *)
   23.68 +  S             :: "histType => bool => bool => bool => mClkState => rpcState => histState => histState => PrIds => stpred"
   23.69 +
   23.70 +  (* predicates S1 -- S6 define special instances of S *)
   23.71 +  S1            :: "histType => PrIds => stpred"
   23.72 +  S2            :: "histType => PrIds => stpred"
   23.73 +  S3            :: "histType => PrIds => stpred"
   23.74 +  S4            :: "histType => PrIds => stpred"
   23.75 +  S5            :: "histType => PrIds => stpred"
   23.76 +  S6            :: "histType => PrIds => stpred"
   23.77 +
   23.78 +  (* auxiliary predicates *)
   23.79 +  MVOKBARF      :: "Vals => bool"
   23.80 +  MVOKBA        :: "Vals => bool"
   23.81 +  MVNROKBA      :: "Vals => bool"
   23.82 +
   23.83 +rules
   23.84 +  MVOKBARF_def  "MVOKBARF v == (MemVal v) | (v = OK) | (v = BadArg) | (v = RPCFailure)"
   23.85 +  MVOKBA_def    "MVOKBA v   == (MemVal v) | (v = OK) | (v = BadArg)"
   23.86 +  MVNROKBA_def  "MVNROKBA v == (MemVal v) | (v = NotAResult) | (v = OK) | (v = BadArg)"
   23.87 +
   23.88 +  (* the "base" variables: everything except resbar and hist (for any index) *)
   23.89 +  MI_base       "base_var <caller memCh @ p, rtrner memCh @ p, 
   23.90 +                           caller crCh @ p, rtrner crCh @ p,
   23.91 +                           caller rmCh @ p, rtrner rmCh @ p,
   23.92 +                           rst@p, cst@p, mem@l, ires@p>"
   23.93 +
   23.94 +  (* Environment's next-state relation *)
   23.95 +  ENext_def     "ENext p == REX l. #(MemLoc l) .& Call memCh p (#(Inl (read,l)))"
   23.96 +
   23.97 +  (* Specification of the history variable used in the proof *)
   23.98 +  HInit_def     "$(HInit rmhist p) .= ($(rmhist@p) .= #histA)"
   23.99 +  HNext_def     "HNext rmhist p == 
  23.100 +                   (rmhist@p)$ .=
  23.101 +                     (.if (MemReturn rmCh ires p .| RPCFail crCh rmCh rst p)
  23.102 +                      .then #histB
  23.103 +                      .else .if (MClkReply memCh crCh cst p)
  23.104 +                            .then #histA
  23.105 +                            .else $(rmhist@p))"
  23.106 +  HistP_def     "HistP rmhist p == 
  23.107 +                    Init($(HInit rmhist p))
  23.108 +                    .& [][HNext rmhist p]_<c p,r p,m p, rmhist@p>"
  23.109 +  Hist_def      "Hist rmhist == RALL p. HistP rmhist p"
  23.110 +
  23.111 +  (* definitions of e,c,r,m *)
  23.112 +  e_def         "e p == caller memCh @ p"
  23.113 +  c_def         "c p == <cst@p, rtrner memCh @ p, caller crCh @ p>"
  23.114 +  r_def         "r p == <rst@p, rtrner crCh @ p, caller rmCh @ p>"
  23.115 +  m_def         "m p == <rtrner rmCh @ p, ires@p>"
  23.116 +
  23.117 +  (* definition of the implementation (without the history variable) *)
  23.118 +  IPImp_def     "IPImp p ==    Init(.~ $(Calling memCh p)) .& [][ENext p]_(e p)
  23.119 +			           .& MClkIPSpec memCh crCh cst p
  23.120 +			           .& RPCIPSpec crCh rmCh rst p
  23.121 +			           .& RPSpec rmCh mem ires p 
  23.122 +			           .& (RALL l. #(MemLoc l) .-> MSpec rmCh mem ires l)"
  23.123 +
  23.124 +  ImpInit_def   "$(ImpInit p) .= (   .~ $(Calling memCh p)    \
  23.125 +\		                  .& $(MClkInit crCh cst p)   \
  23.126 +\		                  .& $(RPCInit rmCh rst p)   \
  23.127 +\		                  .& $(PInit ires p))"
  23.128 +
  23.129 +  ImpNext_def   "ImpNext p ==   [ENext p]_(e p) 
  23.130 +                             .& [MClkNext memCh crCh cst p]_(c p)
  23.131 +                             .& [RPCNext crCh rmCh rst p]_(r p) 
  23.132 +                             .& [RNext rmCh mem ires p]_(m p)"
  23.133 +
  23.134 +  ImpLive_def  "ImpLive p ==   WF(MClkFwd memCh crCh cst p)_(c p) 
  23.135 +			    .& SF(MClkReply memCh crCh cst p)_(c p)
  23.136 +			    .& WF(RPCNext crCh rmCh rst p)_(r p) 
  23.137 +			    .& WF(RNext rmCh mem ires p)_(m p)
  23.138 +			    .& WF(MemReturn rmCh ires p)_(m p)"
  23.139 +
  23.140 +  Impl_def   "Implementation ==    (RALL p. Init(.~ $(Calling memCh p)) .& [][ENext p]_(e p))
  23.141 +                                .& MClkISpec memCh crCh cst
  23.142 +                                .& RPCISpec crCh rmCh rst
  23.143 +                                .& IRSpec rmCh mem ires"
  23.144 +
  23.145 +  ImpInv_def "$(ImpInv rmhist p) .= ($(S1 rmhist p) .| $(S2 rmhist p) .| $(S3 rmhist p) .| 
  23.146 +                                     $(S4 rmhist p) .| $(S5 rmhist p) .| $(S6 rmhist p))"
  23.147 +
  23.148 +  (* Definition of predicate S.
  23.149 +     NB: The second conjunct of the definition in the paper is taken care of by
  23.150 +     the type definitions. The last conjunct is asserted separately as the memory
  23.151 +     invariant MemInv, proved in Memory.ML. *)
  23.152 +  S_def    "$(S rmhist ecalling ccalling rcalling cs rs hs1 hs2 p) .=
  23.153 +              (  ($(Calling memCh p) .= # ecalling)
  23.154 +              .& ($(Calling crCh p) .= # ccalling)
  23.155 +              .& (# ccalling .-> (arg[ $(crCh@p)] .= MClkRelayArg[ arg[$(memCh@p)] ]))
  23.156 +              .& ((.~ # ccalling .& ($(cst@p) .= # clkB)) .-> MVOKBARF[ res[$(crCh@p)] ])
  23.157 +              .& ($(Calling rmCh p) .= # rcalling)
  23.158 +              .& (# rcalling .-> (arg[ $(rmCh@p)] .= RPCRelayArg[ arg[$(crCh@p)] ]))
  23.159 +              .& (.~ # rcalling .-> ($(ires@p) .= # NotAResult))
  23.160 +              .& ((.~ # rcalling .& ($(rst@p) .= # rpcB)) .-> MVOKBA[ res[$(rmCh@p)] ])
  23.161 +              .& ($(cst@p) .= # cs)
  23.162 +              .& ($(rst@p) .= # rs)
  23.163 +              .& (($(rmhist@p) .= #hs1) .| ($(rmhist@p) .= #hs2))
  23.164 +              .& (MVNROKBA[ $(ires@p)]))"
  23.165 +
  23.166 +  S1_def   "$(S1 rmhist p) .= $(S rmhist False False False clkA rpcA histA histA p)"
  23.167 +  S2_def   "$(S2 rmhist p) .= $(S rmhist True False False clkA rpcA histA histA p)"
  23.168 +  S3_def   "$(S3 rmhist p) .= $(S rmhist True True False clkB rpcA histA histB p)"
  23.169 +  S4_def   "$(S4 rmhist p) .= $(S rmhist True True True clkB rpcB histA histB p)"
  23.170 +  S5_def   "$(S5 rmhist p) .= $(S rmhist True True False clkB rpcB histB histB p)"
  23.171 +  S6_def   "$(S6 rmhist p) .= $(S rmhist True False False clkB rpcA histB histB p)"
  23.172 +
  23.173 +  (* Definition of the refinement mapping resbar for result *)
  23.174 +  resbar_def   "$((resbar rmhist) @ p) .=
  23.175 +                  (.if ($(S1 rmhist p) .| $(S2 rmhist p))
  23.176 +                   .then $(ires@p)
  23.177 +                   .else .if $(S3 rmhist p)
  23.178 +                   .then .if $(rmhist@p) .= #histA 
  23.179 +                         .then $(ires@p) .else # MemFailure
  23.180 +                   .else .if $(S4 rmhist p)
  23.181 +                   .then .if ($(rmhist@p) .= #histB) .& ($(ires@p) .= # NotAResult)
  23.182 +                         .then #MemFailure .else $(ires@p)
  23.183 +                   .else .if $(S5 rmhist p)
  23.184 +                   .then res[$(rmCh@p)]
  23.185 +                   .else .if $(S6 rmhist p)
  23.186 +                   .then .if res[$(crCh@p)] .= #RPCFailure
  23.187 +                         .then #MemFailure .else res[$(crCh@p)]
  23.188 +                   .else #NotAResult)" (* dummy value *)
  23.189 +
  23.190 +end
  23.191 +
    24.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    24.2 +++ b/src/HOL/TLA/Memory/MemoryParameters.ML	Wed Oct 08 11:50:33 1997 +0200
    24.3 @@ -0,0 +1,24 @@
    24.4 +(* 
    24.5 +    File:        MemoryParameters.ML
    24.6 +    Author:      Stephan Merz
    24.7 +    Copyright:   1997 University of Munich
    24.8 +
    24.9 +    RPC-Memory example: memory parameters (ML file)
   24.10 +*)
   24.11 +
   24.12 +val MP_simps = [BadArgNoMemVal,MemFailNoMemVal,InitValMemVal,NotAResultNotVal,
   24.13 +                  NotAResultNotOK, NotAResultNotBA, NotAResultNotMF]
   24.14 +               @ (map (fn x => x RS not_sym) 
   24.15 +                      [NotAResultNotOK, NotAResultNotBA, NotAResultNotMF]);
   24.16 +
   24.17 +
   24.18 +(* Auxiliary rules *)
   24.19 +
   24.20 +qed_goal "MemValNotAResultE" MemoryParameters.thy
   24.21 +   "[| MemVal x; (x ~= NotAResult ==> P) |] ==> P"
   24.22 +   (fn [min,maj] => [rtac maj 1,
   24.23 +                     case_tac "x = NotAResult" 1,
   24.24 +                     cut_facts_tac [min,NotAResultNotVal] 1,
   24.25 +                     ALLGOALS Asm_full_simp_tac
   24.26 +                    ]);
   24.27 +
    25.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    25.2 +++ b/src/HOL/TLA/Memory/MemoryParameters.thy	Wed Oct 08 11:50:33 1997 +0200
    25.3 @@ -0,0 +1,50 @@
    25.4 +(*
    25.5 +    File:        MemoryParameters.thy
    25.6 +    Author:      Stephan Merz
    25.7 +    Copyright:   1997 University of Munich
    25.8 +
    25.9 +    Theory Name: MemoryParameters
   25.10 +    Logic Image: TLA
   25.11 +
   25.12 +    RPC-Memory example: Memory parameters
   25.13 +*)
   25.14 +
   25.15 +MemoryParameters = Prod + Sum + Arith + RPCMemoryParams +
   25.16 +
   25.17 +(* the memory operations. nb: data types must be defined in theories
   25.18 +   that do not include Intensional -- otherwise the induction rule
   25.19 +   can't be type-checked unambiguously.
   25.20 +*)
   25.21 +datatype  Rd = read
   25.22 +datatype  Wr = write
   25.23 +
   25.24 +types
   25.25 +  (* legal arguments for the memory *)
   25.26 +  memArgType = "(Rd * Locs) + (Wr * Locs * Vals)"
   25.27 +
   25.28 +consts
   25.29 +  (* memory locations and contents *)
   25.30 +  MemLoc         :: "Locs => bool"
   25.31 +  MemVal         :: "Vals => bool"
   25.32 +
   25.33 +  (* some particular values *)
   25.34 +  OK             :: "Vals"
   25.35 +  BadArg         :: "Vals"
   25.36 +  MemFailure     :: "Vals"
   25.37 +  NotAResult     :: "Vals"  (* defined here for simplicity *)
   25.38 +  
   25.39 +  (* the initial value stored in each memory cell *)
   25.40 +  InitVal        :: "Vals"
   25.41 +
   25.42 +rules
   25.43 +  (* basic assumptions about the above constants and predicates *)
   25.44 +  BadArgNoMemVal    "~MemVal(BadArg)"
   25.45 +  MemFailNoMemVal   "~MemVal(MemFailure)"
   25.46 +  InitValMemVal     "MemVal(InitVal)"
   25.47 +  NotAResultNotVal  "~MemVal(NotAResult)"
   25.48 +  NotAResultNotOK   "NotAResult ~= OK"
   25.49 +  NotAResultNotBA   "NotAResult ~= BadArg"
   25.50 +  NotAResultNotMF   "NotAResult ~= MemFailure"
   25.51 +end
   25.52 +
   25.53 +
    26.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    26.2 +++ b/src/HOL/TLA/Memory/ProcedureInterface.ML	Wed Oct 08 11:50:33 1997 +0200
    26.3 @@ -0,0 +1,62 @@
    26.4 +(* 
    26.5 +    File:        ProcedureInterface.ML
    26.6 +    Author:      Stephan Merz
    26.7 +    Copyright:   1997 University of Munich
    26.8 +
    26.9 +    Procedure interface (ML file)
   26.10 +*)
   26.11 +
   26.12 +Addsimps [slice_def];
   26.13 +
   26.14 +(* ---------------------------------------------------------------------------- *)
   26.15 +
   26.16 +val Procedure_defs = [caller_def, rtrner_def, action_rewrite Calling_def, 
   26.17 +                      Call_def, Return_def,
   26.18 +		      PLegalCaller_def, LegalCaller_def,
   26.19 +		      PLegalReturner_def, LegalReturner_def];
   26.20 +
   26.21 +(* sample theorems (not used in the proof):
   26.22 +   1. calls and returns are mutually exclusive
   26.23 +
   26.24 +qed_goal "CallReturnMutex" ProcedureInterface.thy
   26.25 +     "Call ch p v .-> .~ Return ch p w"
   26.26 +  (fn prems => [ auto_tac (action_css addsimps2 [Call_def,Return_def]) ]);
   26.27 +
   26.28 +
   26.29 +  2. enabledness of calls and returns
   26.30 +     NB: action_simp_tac is significantly faster than auto_tac
   26.31 +
   26.32 +qed_goal "Call_enabled" ProcedureInterface.thy
   26.33 +   "!!p. base_var ((caller ch)@p) ==> (.~ $(Calling ch p) .-> $(Enabled (Call ch p (#v))))"
   26.34 +   (fn _ => [action_simp_tac (!simpset addsimps [caller_def, Call_def]) 
   26.35 +                             [] [base_enabled,Pair_inject] 1
   26.36 +            ]);
   26.37 +
   26.38 +qed_goal "Return_enabled" ProcedureInterface.thy
   26.39 +   "!!p. base_var ((rtrner ch)@p) ==> $(Calling ch p) .-> $(Enabled (Return ch p (#v)))"
   26.40 +   (fn _ => [action_simp_tac (!simpset addsimps [rtrner_def, Return_def]) 
   26.41 +                             [] [base_enabled,Pair_inject] 1
   26.42 +            ]);
   26.43 +
   26.44 +*)
   26.45 +
   26.46 +(* Calls and returns change their subchannel *)
   26.47 +qed_goal "Call_changed" ProcedureInterface.thy
   26.48 +   "Call ch p v .-> <Call ch p v>_((caller ch)@p)"
   26.49 +   (fn _ => [auto_tac (!claset,
   26.50 +		       !simpset addsimps [angle_def,Call_def,caller_def,
   26.51 +					  action_rewrite Calling_def])
   26.52 +	    ]);
   26.53 +
   26.54 +qed_goal "Return_changed" ProcedureInterface.thy
   26.55 +   "Return ch p v .-> <Return ch p v>_((rtrner ch)@p)"
   26.56 +   (fn _ => [auto_tac (!claset,
   26.57 +		       !simpset addsimps [angle_def,Return_def,rtrner_def,
   26.58 +					  action_rewrite Calling_def])
   26.59 +	    ]);
   26.60 +
   26.61 +(* For convenience, generate elimination rules. 
   26.62 +   These rules loop if angle_def is active! *)
   26.63 +bind_thm("Call_changedE", action_impE Call_changed);
   26.64 +bind_thm("Return_changedE", action_impE Return_changed);
   26.65 +
    27.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    27.2 +++ b/src/HOL/TLA/Memory/ProcedureInterface.thy	Wed Oct 08 11:50:33 1997 +0200
    27.3 @@ -0,0 +1,75 @@
    27.4 +(*
    27.5 +    File:        ProcedureInterface.thy
    27.6 +    Author:      Stephan Merz
    27.7 +    Copyright:   1997 University of Munich
    27.8 +
    27.9 +   Theory Name: ProcedureInterface
   27.10 +   Logic Image: TLA
   27.11 +
   27.12 +   Procedure interface for RPC-Memory components.
   27.13 +*)
   27.14 +
   27.15 +ProcedureInterface = TLA + RPCMemoryParams +
   27.16 +
   27.17 +types
   27.18 +  (* type of channels with argument type 'a and return type 'r.
   27.19 +     we model a channel as an array of variables (of type chan) 
   27.20 +     rather than a single array-valued variable because the 
   27.21 +     notation gets a little simpler.
   27.22 +  *)
   27.23 +  ('a,'r) chan
   27.24 +  ('a,'r) channel = (PrIds => ('a,'r) chan) stfun
   27.25 +
   27.26 +arities
   27.27 +  chan :: (term,term) term
   27.28 +
   27.29 +consts
   27.30 +  (* data-level functions *)
   27.31 +  cbit,rbit	:: "('a,'r) chan => bit"
   27.32 +  arg           :: "('a,'r) chan => 'a"
   27.33 +  res           :: "('a,'r) chan => 'r"
   27.34 +
   27.35 +  (* slice through array-valued state function *)
   27.36 +  "@"           :: "('a => 'b) stfun => 'a => 'b stfun"   (infixl 20)
   27.37 +
   27.38 +  (* state functions *)
   27.39 +  caller	:: "('a,'r) channel => (PrIds => (bit * 'a)) stfun"
   27.40 +  rtrner        :: "('a,'r) channel => (PrIds => (bit * 'r)) stfun"
   27.41 +
   27.42 +  (* state predicates *)
   27.43 +  Calling   :: "('a,'r) channel => PrIds => stpred"
   27.44 +
   27.45 +  (* actions *)
   27.46 +  Call      :: "('a,'r) channel => PrIds => 'a trfct => action"
   27.47 +  Return    :: "('a,'r) channel => PrIds => 'r trfct => action"
   27.48 +
   27.49 +  (* temporal formulas *)
   27.50 +  PLegalCaller      :: "('a,'r) channel => PrIds => temporal"
   27.51 +  LegalCaller       :: "('a,'r) channel => temporal"
   27.52 +  PLegalReturner    :: "('a,'r) channel => PrIds => temporal"
   27.53 +  LegalReturner     :: "('a,'r) channel => temporal"
   27.54 +
   27.55 +rules
   27.56 +  slice_def     "(x@i) s == x s i"
   27.57 +
   27.58 +  caller_def	"caller ch s p   == (cbit (ch s p), arg (ch s p))"
   27.59 +  rtrner_def	"rtrner ch s p   == (rbit (ch s p), res (ch s p))"
   27.60 +
   27.61 +  Calling_def	"$(Calling ch p)  .= (cbit[$(ch@p)] .~= rbit[$(ch@p)])"
   27.62 +  Call_def      "Call ch p v   == .~ $(Calling ch p)
   27.63 +                                  .& (cbit[$(ch@p)])` .~= rbit[$(ch@p)]
   27.64 +                                  .& (arg[$(ch@p)])` .= v"
   27.65 +  Return_def    "Return ch p v == $(Calling ch p)
   27.66 +                                  .& (rbit[$(ch@p)])` .= cbit[$(ch@p)]
   27.67 +                                  .& (res[$(ch@p)])` .= v"
   27.68 +
   27.69 +  PLegalCaller_def      "PLegalCaller ch p ==
   27.70 +                             Init(.~ $(Calling ch p))
   27.71 +                             .& [][ REX a. Call ch p (#a) ]_((caller ch)@p)"
   27.72 +  LegalCaller_def       "LegalCaller ch == RALL p. PLegalCaller ch p"
   27.73 +  PLegalReturner_def    "PLegalReturner ch p ==
   27.74 +                                [][ REX v. Return ch p (#v) ]_((rtrner ch)@p)"
   27.75 +  LegalReturner_def     "LegalReturner ch == RALL p. PLegalReturner ch p"
   27.76 +
   27.77 +end
   27.78 +
    28.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    28.2 +++ b/src/HOL/TLA/Memory/RPC.ML	Wed Oct 08 11:50:33 1997 +0200
    28.3 @@ -0,0 +1,59 @@
    28.4 +(* 
    28.5 +    File:        RPC.ML
    28.6 +    Author:      Stephan Merz
    28.7 +    Copyright:   1997 University of Munich
    28.8 +
    28.9 +    RPC-Memory example: RPC specification (ML file)
   28.10 +*)
   28.11 +
   28.12 +val RPC_action_defs = 
   28.13 +   [RPCInit_def RS inteq_reflection]
   28.14 +   @ [RPCFwd_def, RPCReject_def, RPCFail_def, RPCReply_def, RPCNext_def];
   28.15 +
   28.16 +val RPC_temp_defs = [RPCIPSpec_def, RPCISpec_def];
   28.17 +
   28.18 +(* The RPC component engages in an action for process p only if there is an outstanding,
   28.19 +   unanswered call for that process.
   28.20 +*)
   28.21 +
   28.22 +qed_goal "RPCidle" RPC.thy
   28.23 +   ".~ $(Calling send p) .-> .~ RPCNext send rcv rst p"
   28.24 +   (fn _ => [ auto_tac (action_css addsimps2 (Return_def::RPC_action_defs)) ]);
   28.25 +
   28.26 +qed_goal "RPCbusy" RPC.thy
   28.27 +   "$(Calling rcv p) .& ($(rst@p) .= #rpcB) .-> .~ RPCNext send rcv rst p"
   28.28 +   (fn _ => [ auto_tac (action_css addsimps2 (RP_simps @ RPC_action_defs)) ]);
   28.29 +
   28.30 +(* unlifted versions as introduction rules *)
   28.31 +
   28.32 +bind_thm("RPCidleI", action_mp RPCidle);
   28.33 +bind_thm("RPCbusyI", action_mp RPCbusy);
   28.34 +
   28.35 +(* RPC failure actions are visible. *)
   28.36 +qed_goal "RPCFail_vis" RPC.thy
   28.37 +   "RPCFail send rcv rst p .-> <RPCNext send rcv rst p>_<rst@p, rtrner send @ p, caller rcv @ p>"
   28.38 +   (fn _ => [auto_tac (!claset addSEs [Return_changedE],
   28.39 +		       !simpset addsimps [angle_def,RPCNext_def,RPCFail_def])
   28.40 +	    ]);
   28.41 +
   28.42 +qed_goal "RPCFail_Next_enabled" RPC.thy
   28.43 +   "Enabled (RPCFail send rcv rst p) s \
   28.44 +\   ==> Enabled (<RPCNext send rcv rst p>_<rst@p, rtrner send @ p, caller rcv @ p>) s"
   28.45 +   (fn [prem] => [REPEAT (resolve_tac [prem RS enabled_mono,RPCFail_vis] 1)]);
   28.46 +
   28.47 +(* Enabledness of some actions *)
   28.48 +
   28.49 +qed_goal "RPCFail_enabled" RPC.thy
   28.50 +   "!!p. base_var <rtrner send @ p, caller rcv @ p, rst@p> ==> \
   28.51 +\        .~ $(Calling rcv p) .& $(Calling send p) .-> $(Enabled (RPCFail send rcv rst p))"
   28.52 +   (fn _ => [action_simp_tac (!simpset addsimps [RPCFail_def,Return_def,caller_def,rtrner_def])
   28.53 +                             [] [base_enabled,Pair_inject] 1
   28.54 +	    ]);
   28.55 +
   28.56 +qed_goal "RPCReply_enabled" RPC.thy
   28.57 +   "!!p. base_var <rtrner send @ p, caller rcv @ p, rst@p> ==> \
   28.58 +\        .~ $(Calling rcv p) .& $(Calling send p) .& $(rst@p) .= #rpcB \
   28.59 +\        .-> $(Enabled (RPCReply send rcv rst p))"
   28.60 +   (fn _ => [action_simp_tac (!simpset addsimps [RPCReply_def,Return_def,caller_def,rtrner_def])
   28.61 +                             [] [base_enabled,Pair_inject] 1]);
   28.62 +
    29.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    29.2 +++ b/src/HOL/TLA/Memory/RPC.thy	Wed Oct 08 11:50:33 1997 +0200
    29.3 @@ -0,0 +1,84 @@
    29.4 +(*
    29.5 +    File:        RPC.thy
    29.6 +    Author:      Stephan Merz
    29.7 +    Copyright:   1997 University of Munich
    29.8 +
    29.9 +    Theory Name: RPC
   29.10 +    Logic Image: TLA
   29.11 +
   29.12 +    RPC-Memory example: RPC specification
   29.13 +    For simplicity, specify the instance of RPC that is used in the
   29.14 +    memory implementation (ignoring the BadCall exception).
   29.15 +*)
   29.16 +
   29.17 +RPC = RPCParameters + ProcedureInterface +
   29.18 +
   29.19 +types
   29.20 +  rpcSndChType  = "(rpcArgType,Vals) channel"
   29.21 +  rpcRcvChType  = "(memArgType,Vals) channel"
   29.22 +  rpcStType     = "(PrIds => rpcState) stfun"
   29.23 +
   29.24 +consts
   29.25 +  (* state predicates *)
   29.26 +  RPCInit      :: "rpcRcvChType => rpcStType => PrIds => stpred"
   29.27 +
   29.28 +  (* actions *)
   29.29 +  RPCFwd     :: "rpcSndChType => rpcRcvChType => rpcStType => PrIds => action"
   29.30 +  RPCReject  :: "rpcSndChType => rpcRcvChType => rpcStType => PrIds => action"
   29.31 +  RPCFail    :: "rpcSndChType => rpcRcvChType => rpcStType => PrIds => action"
   29.32 +  RPCReply   :: "rpcSndChType => rpcRcvChType => rpcStType => PrIds => action"
   29.33 +  RPCNext    :: "rpcSndChType => rpcRcvChType => rpcStType => PrIds => action"
   29.34 +
   29.35 +  (* temporal *)
   29.36 +  RPCIPSpec   :: "rpcSndChType => rpcRcvChType => rpcStType => PrIds => temporal"
   29.37 +  RPCISpec   :: "rpcSndChType => rpcRcvChType => rpcStType => temporal"
   29.38 +
   29.39 +rules
   29.40 +  RPCInit_def       "$(RPCInit rcv rst p) .= 
   29.41 +                         ($(rst@p) .= # rpcA
   29.42 +                          .& .~ $(Calling rcv p))"
   29.43 +
   29.44 +  RPCFwd_def        "RPCFwd send rcv rst p ==
   29.45 +                         $(Calling send p)
   29.46 +                         .& $(rst@p) .= # rpcA
   29.47 +                         .& IsLegalRcvArg[ arg[ $(send@p) ] ]
   29.48 +                         .& Call rcv p (RPCRelayArg[ arg[ $(send@p)] ])
   29.49 +                         .& (rst@p)$ .= # rpcB
   29.50 +                         .& unchanged (rtrner send @ p)"
   29.51 +
   29.52 +  RPCReject_def     "RPCReject send rcv rst p ==
   29.53 +                         $(rst@p) .= # rpcA
   29.54 +                         .& .~ IsLegalRcvArg[ arg[ $(send@p) ] ]
   29.55 +                         .& Return send p (#BadCall)
   29.56 +                         .& unchanged <(rst@p), (caller rcv @ p)>"
   29.57 +
   29.58 +  RPCFail_def       "RPCFail send rcv rst p ==
   29.59 +                         .~ $(Calling rcv p)
   29.60 +                         .& Return send p (#RPCFailure)
   29.61 +                         .& (rst@p)$ .= #rpcA
   29.62 +                         .& unchanged (caller rcv @ p)"
   29.63 +
   29.64 +  RPCReply_def      "RPCReply send rcv rst p ==
   29.65 +                         .~ $(Calling rcv p)
   29.66 +                         .& $(rst@p) .= #rpcB
   29.67 +                         .& Return send p (res[$(rcv@p)])
   29.68 +                         .& (rst@p)$ .= #rpcA
   29.69 +                         .& unchanged (caller rcv @ p)"
   29.70 +
   29.71 +  RPCNext_def       "RPCNext send rcv rst p ==
   29.72 +                         RPCFwd send rcv rst p
   29.73 +                         .| RPCReject send rcv rst p
   29.74 +                         .| RPCFail send rcv rst p
   29.75 +                         .| RPCReply send rcv rst p"
   29.76 +
   29.77 +  RPCIPSpec_def     "RPCIPSpec send rcv rst p ==
   29.78 +                         Init($(RPCInit rcv rst p))
   29.79 +                         .& [][ RPCNext send rcv rst p ]_<rst@p, rtrner send @ p, caller rcv @ p>
   29.80 +                         .& WF(RPCNext send rcv rst p)_<rst@p, rtrner send @ p, caller rcv @ p>"
   29.81 +
   29.82 +  RPCISpec_def      "RPCISpec send rcv rst == RALL p. RPCIPSpec send rcv rst p"
   29.83 +
   29.84 +end
   29.85 +
   29.86 +
   29.87 +
    30.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    30.2 +++ b/src/HOL/TLA/Memory/RPCMemoryParams.thy	Wed Oct 08 11:50:33 1997 +0200
    30.3 @@ -0,0 +1,28 @@
    30.4 +(* 
    30.5 +    File:        RPCMemoryParams.thy
    30.6 +    Author:      Stephan Merz
    30.7 +    Copyright:   1997 University of Munich
    30.8 +
    30.9 +    Theory Name: RPCMemoryParams
   30.10 +    Logic Image: TLA
   30.11 +
   30.12 +    Basic declarations for the RPC-memory example.
   30.13 +*)
   30.14 +
   30.15 +RPCMemoryParams = HOL +
   30.16 +
   30.17 +types
   30.18 +  bit = "bool"   (* signal wires for the procedure interface *)
   30.19 +                 (* Defined as bool for simplicity. All I should really need is *)
   30.20 +                 (* the existence of two distinct values. *)
   30.21 +  Locs           (* "syntactic" value type *)
   30.22 +  Vals           (* "syntactic" value type *)
   30.23 +  PrIds          (* process id's *)
   30.24 +
   30.25 +(* all of these are simple (HOL) types *)
   30.26 +arities
   30.27 +  Locs   :: term
   30.28 +  Vals   :: term
   30.29 +  PrIds  :: term
   30.30 +
   30.31 +end
    31.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    31.2 +++ b/src/HOL/TLA/Memory/RPCParameters.ML	Wed Oct 08 11:50:33 1997 +0200
    31.3 @@ -0,0 +1,12 @@
    31.4 +(* 
    31.5 +    File:        RPCParameters.ML
    31.6 +    Author:      Stephan Merz
    31.7 +    Copyright:   1997 University of Munich
    31.8 +
    31.9 +    RPC-Memory example: RPC parameters (ML file)
   31.10 +*)
   31.11 +
   31.12 +
   31.13 +val RP_simps = MP_simps @ [RFNoMemVal, NotAResultNotRF, OKNotRF, BANotRF]
   31.14 +                        @ (map (fn x => x RS not_sym) [NotAResultNotRF, OKNotRF, BANotRF])
   31.15 +                        @ rpcOps.simps @ rpcState.simps;
    32.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    32.2 +++ b/src/HOL/TLA/Memory/RPCParameters.thy	Wed Oct 08 11:50:33 1997 +0200
    32.3 @@ -0,0 +1,54 @@
    32.4 +(*
    32.5 +    File:        RPCParameters.thy
    32.6 +    Author:      Stephan Merz
    32.7 +    Copyright:   1997 University of Munich
    32.8 +
    32.9 +    Theory Name: RPCParameters
   32.10 +    Logic Image: TLA
   32.11 +
   32.12 +    RPC-Memory example: RPC parameters
   32.13 +    For simplicity, specify the instance of RPC that is used in the
   32.14 +    memory implementation.
   32.15 +*)
   32.16 +
   32.17 +RPCParameters = MemoryParameters +
   32.18 +
   32.19 +datatype  rpcOps = remoteCall
   32.20 +datatype  rpcState = rpcA | rpcB
   32.21 +
   32.22 +types
   32.23 +  (* type of RPC arguments other than memory calls *)
   32.24 +  noMemArgType
   32.25 +  (* legal arguments for (our instance of) the RPC component *)
   32.26 +  rpcArgType = "(rpcOps * memArgType) + (rpcOps * noMemArgType)"
   32.27 +
   32.28 +arities
   32.29 +  noMemArgType :: term
   32.30 +
   32.31 +consts
   32.32 +  (* some particular return values *)
   32.33 +  RPCFailure     :: "Vals"
   32.34 +  BadCall        :: "Vals"
   32.35 +  
   32.36 +  (* Translate an rpc call to a memory call and test if the current argument
   32.37 +     is legal for the receiver (i.e., the memory). This can now be a little
   32.38 +     simpler than for the generic RPC component. RelayArg returns an arbitrary
   32.39 +     memory call for illegal arguments. *)
   32.40 +  IsLegalRcvArg  :: "rpcArgType => bool"
   32.41 +  RPCRelayArg    :: "rpcArgType => memArgType"
   32.42 +
   32.43 +rules
   32.44 +  (* RPCFailure is different from MemVals and exceptions *)
   32.45 +  RFNoMemVal        "~(MemVal RPCFailure)"
   32.46 +  NotAResultNotRF   "NotAResult ~= RPCFailure"
   32.47 +  OKNotRF           "OK ~= RPCFailure"
   32.48 +  BANotRF           "BadArg ~= RPCFailure"
   32.49 +
   32.50 +  IsLegalRcvArg_def "IsLegalRcvArg ra == EX marg. ra = Inl (remoteCall,marg)"
   32.51 +  RPCRelayArg_def   "RPCRelayArg ra == 
   32.52 +                         case ra of Inl (rm) => (snd rm)
   32.53 +                                  | Inr (rn) => Inl (read, @ l. True)"
   32.54 +
   32.55 +end
   32.56 +
   32.57 +
    33.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    33.2 +++ b/src/HOL/TLA/README.html	Wed Oct 08 11:50:33 1997 +0200
    33.3 @@ -0,0 +1,45 @@
    33.4 +<HTML><HEAD><TITLE>HOL/TLA/README</TITLE></HEAD><BODY bgcolor="white">
    33.5 +
    33.6 +<H3>TLA: A formalization of TLA in HOL</H3>
    33.7 +
    33.8 +Author:     Stephan Merz<BR>
    33.9 +Copyright   1997 Universit&auml;t M&uuml;nchen<P>
   33.10 +
   33.11 +The distribution contains a representation of Lamport's
   33.12 +<A HREF="http://www.research.digital.com/SRC/personal/Leslie_Lamport/tla/tla.html">
   33.13 +Temporal Logic of Actions</A>
   33.14 +in Isabelle/HOL.
   33.15 +
   33.16 +<p>
   33.17 +
   33.18 +The encoding is mainly oriented towards practical verification
   33.19 +examples. It does not contain a formalization of TLA's semantics;
   33.20 +instead, it is based on a 
   33.21 +<A HREF="doc/PTLA.dvi">complete axiomatization</A> of the "raw"
   33.22 +(stuttering-sensitive) variant of propositional TLA. It is
   33.23 +accompanied by a
   33.24 +<A HREF="doc/design.dvi">design note</A> that explains the basic 
   33.25 +setup and use of the prover.
   33.26 +
   33.27 +<p>
   33.28 +
   33.29 +The distribution includes the following examples:
   33.30 +<UL>
   33.31 +  <li> a verification of Lamport's <quote>increment</quote> example
   33.32 +  (subdirectory inc),<P>
   33.33 +
   33.34 +  <li> a proof that two buffers in a row implement a single buffer
   33.35 +  (subdirectory buffer), and<P>
   33.36 +
   33.37 +   <li> the verification of Broy and Lamport's RPC-Memory example. For details see:<BR>
   33.38 +
   33.39 +        Mart&iacute;n Abadi, Leslie Lamport, and Stephan Merz: 
   33.40 +        <A HREF="http://www4.informatik.tu-muenchen.de/~merz/papers/RPCMemory.html">
   33.41 +        A TLA Solution to the RPC-Memory Specification Problem</A>.
   33.42 +        In: <i>Formal System Specification</i>, LNCS 1169, 1996, 21-69.
   33.43 +</UL>
   33.44 +
   33.45 +If you use Isabelle/TLA and have any comments, suggestions or contributions,
   33.46 +please contact <A HREF="mailto:merz@informatik.uni-muenchen.de">Stephan Merz</A>.
   33.47 +
   33.48 +</BODY></HTML>
    34.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    34.2 +++ b/src/HOL/TLA/ROOT.ML	Wed Oct 08 11:50:33 1997 +0200
    34.3 @@ -0,0 +1,17 @@
    34.4 +(*  Title:      TLA/ROOT.ML
    34.5 +
    34.6 +Adds the Temporal Logic of Actions to a database containing Isabelle/HOL.
    34.7 +*)
    34.8 +
    34.9 +val banner = "Temporal Logic of Actions";
   34.10 +
   34.11 +(*
   34.12 +   raise the ambiguity level to avoid ambiguity warnings;
   34.13 +   since Trueprop and TrueInt have both empty syntax, there is
   34.14 +   an unavoidable ambiguity in the TLA (actually, Intensional) grammar.
   34.15 +*)
   34.16 +Syntax.ambiguity_level := 10000;
   34.17 +
   34.18 +use_thy "TLA";
   34.19 +
   34.20 +val TLA_build_completed = ();
    35.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    35.2 +++ b/src/HOL/TLA/Stfun.ML	Wed Oct 08 11:50:33 1997 +0200
    35.3 @@ -0,0 +1,25 @@
    35.4 +(* 
    35.5 +    File:	 Stfun.ML
    35.6 +    Author:      Stephan Merz
    35.7 +    Copyright:   1997 University of Munich
    35.8 +
    35.9 +Lemmas and tactics for states and state functions.
   35.10 +*)
   35.11 +
   35.12 +(* A stronger version of existential elimination (goal needn't be boolean) *)
   35.13 +qed_goalw "exE_prop" HOL.thy [Ex_def]
   35.14 +  "[| ? x::'a.P(x); !!x. P(x) ==> PROP R |] ==> PROP R"
   35.15 +  (fn prems => [REPEAT(resolve_tac prems 1)]);
   35.16 +
   35.17 +(* Might as well use that version in automated proofs *)
   35.18 +AddSEs [exE_prop];
   35.19 +
   35.20 +(*  [| base_var v; !!x. v x = c ==> PROP R |] ==> PROP R  *)
   35.21 +bind_thm("baseE", (standard (base_var RS exE_prop)));
   35.22 +
   35.23 +qed_goal "PairVarE" Stfun.thy
   35.24 +  "[| <v,w> u = (x,y); [| v u = x; w u = y |] ==> PROP R |] ==> PROP R"
   35.25 +  (fn prems => [cut_facts_tac prems 1, resolve_tac prems 1,
   35.26 +		ALLGOALS (asm_full_simp_tac (!simpset addsimps [pairSF_def]))
   35.27 +               ]);
   35.28 +
    36.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    36.2 +++ b/src/HOL/TLA/Stfun.thy	Wed Oct 08 11:50:33 1997 +0200
    36.3 @@ -0,0 +1,56 @@
    36.4 +(* 
    36.5 +    File:	 TLA/Stfun.thy
    36.6 +    Author:      Stephan Merz
    36.7 +    Copyright:   1997 University of Munich
    36.8 +
    36.9 +    Theory Name: Stfun
   36.10 +    Logic Image: HOL
   36.11 +
   36.12 +States and state functions for TLA
   36.13 +*)
   36.14 +
   36.15 +Stfun  =  Prod +
   36.16 +
   36.17 +types
   36.18 +    state
   36.19 +    'a stfun = "state => 'a"
   36.20 +    stpred   = "bool stfun"
   36.21 +
   36.22 +arities
   36.23 +    state :: term
   36.24 +
   36.25 +consts
   36.26 +  (* For simplicity, we do not syntactically distinguish between state variables
   36.27 +     and state functions, and treat "state" as an anonymous type. But we need a 
   36.28 +     "meta-predicate" to identify "base" state variables that represent the state
   36.29 +     components of a system, in particular to define the enabledness of actions.
   36.30 +  *)
   36.31 +  base_var  :: "'a stfun => bool"
   36.32 +
   36.33 +  (* lift tupling to state functions *)
   36.34 +  pairSF    :: "['a stfun, 'b stfun] => ('a * 'b) stfun"
   36.35 +
   36.36 +syntax
   36.37 +  "@tupleSF"     :: "args => ('a * 'b) stfun"  ("(1<_>)")
   36.38 +
   36.39 +translations
   36.40 +  "<x,y,z>"   == "<x, <y,z> >"
   36.41 +  "<x,y>"     == "pairSF x y"
   36.42 +  "<x>"       => "x"
   36.43 +
   36.44 +rules
   36.45 +  (* tupling *)
   36.46 +  pairSF_def  "<v,w>(s) = (v(s),w(s))"
   36.47 +
   36.48 +  (* "base" variables may be assigned arbitrary values by states.
   36.49 +     NB: It's really stronger than that because "u" doesn't depend 
   36.50 +         on either c or v. In particular, if "==>" were replaced
   36.51 +         with "==", base_pair would (still) not be derivable.
   36.52 +  *)
   36.53 +  base_var    "base_var v ==> EX u. v u = c"
   36.54 +
   36.55 +  (* a tuple of variables is "base" if each variable is "base" *)
   36.56 +  base_pair   "base_var <v,w> = (base_var v & base_var w)"
   36.57 +end
   36.58 +
   36.59 +ML
    37.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    37.2 +++ b/src/HOL/TLA/TLA.ML	Wed Oct 08 11:50:33 1997 +0200
    37.3 @@ -0,0 +1,1059 @@
    37.4 +(* 
    37.5 +    File:	 TLA/TLA.ML
    37.6 +    Author:      Stephan Merz
    37.7 +    Copyright:   1997 University of Munich
    37.8 +
    37.9 +Lemmas and tactics for temporal reasoning.
   37.10 +*)
   37.11 +
   37.12 +(* Specialize intensional introduction/elimination rules to temporal formulas *)
   37.13 +
   37.14 +qed_goal "tempI" TLA.thy "(!!sigma. (sigma |= (F::temporal))) ==> F"
   37.15 +  (fn [prem] => [ REPEAT (resolve_tac [prem,intI] 1) ]);
   37.16 +
   37.17 +qed_goal "tempD" TLA.thy "F::temporal ==> (sigma |= F)"
   37.18 +  (fn [prem] => [ REPEAT (resolve_tac [prem,intD] 1) ]);
   37.19 +
   37.20 +
   37.21 +(* ======== Functions to "unlift" temporal implications into HOL rules ====== *)
   37.22 +
   37.23 +(* Basic unlifting introduces a parameter "sigma" and applies basic rewrites, e.g.
   37.24 +   F .= G    gets   (sigma |= F) = (sigma |= G)
   37.25 +   F .-> G   gets   (sigma |= F) --> (sigma |= G)
   37.26 +*)
   37.27 +fun temp_unlift th = rewrite_rule intensional_rews (th RS tempD);
   37.28 +
   37.29 +(* F .-> G   becomes   sigma |= F  ==>  sigma |= G *)
   37.30 +fun temp_mp th = zero_var_indexes ((temp_unlift th) RS mp);
   37.31 +
   37.32 +(* F .-> G   becomes   [| sigma |= F; sigma |= G ==> R |] ==> R 
   37.33 +   so that it can be used as an elimination rule
   37.34 +*)
   37.35 +fun temp_impE th = zero_var_indexes ((temp_unlift th) RS impE);
   37.36 +
   37.37 +(* F .& G .-> H  becomes  [| sigma |= F; sigma |= G |] ==> sigma |= H *)
   37.38 +fun temp_conjmp th = zero_var_indexes (conjI RS (temp_mp th));
   37.39 +
   37.40 +(* F .& G .-> H  becomes  [| sigma |= F; sigma |= G; (sigma |= H ==> R) |] ==> R *)
   37.41 +fun temp_conjimpE th = zero_var_indexes (conjI RS (temp_impE th));
   37.42 +
   37.43 +(* Turn  F .= G  into meta-level rewrite rule  F == G *)
   37.44 +fun temp_rewrite th = (rewrite_rule intensional_rews (th RS inteq_reflection));
   37.45 +
   37.46 +
   37.47 +(* Update classical reasoner---will be updated once more below! *)
   37.48 +
   37.49 +AddSIs [tempI];
   37.50 +AddDs [tempD];
   37.51 +
   37.52 +val temp_cs = action_cs addSIs [tempI] addDs [tempD];
   37.53 +val temp_css = (temp_cs,!simpset);
   37.54 +
   37.55 +(* ========================================================================= *)
   37.56 +section "Init";
   37.57 +
   37.58 +(* Push logical connectives through Init. *)
   37.59 +qed_goal "Init_true" TLA.thy "Init(#True) .= #True"
   37.60 +  (fn _ => [ auto_tac (temp_css addsimps2 [Init_def]) ]);
   37.61 +
   37.62 +qed_goal "Init_false" TLA.thy "Init(#False) .= #False"
   37.63 +  (fn _ => [ auto_tac (temp_css addsimps2 [Init_def]) ]);
   37.64 +
   37.65 +qed_goal "Init_not" TLA.thy "Init(.~P) .= (.~Init(P))"
   37.66 +  (fn _ => [ auto_tac (temp_css addsimps2 [Init_def]) ]);
   37.67 +
   37.68 +qed_goal "Init_and" TLA.thy "Init(P .& Q) .= (Init(P) .& Init(Q))"
   37.69 +  (fn _ => [ auto_tac (temp_css addsimps2 [Init_def]) ]);
   37.70 +
   37.71 +qed_goal "Init_or" TLA.thy "Init(P .| Q) .= (Init(P) .| Init(Q))"
   37.72 +  (fn _ => [ auto_tac (temp_css addsimps2 [Init_def]) ]);
   37.73 +
   37.74 +qed_goal "Init_imp" TLA.thy "Init(P .-> Q) .= (Init(P) .-> Init(Q))"
   37.75 +  (fn _ => [ auto_tac (temp_css addsimps2 [Init_def]) ]);
   37.76 +
   37.77 +qed_goal "Init_iff" TLA.thy "Init(P .= Q) .= (Init(P) .= Init(Q))"
   37.78 +  (fn _ => [ auto_tac (temp_css addsimps2 [Init_def]) ]);
   37.79 +
   37.80 +qed_goal "Init_all" TLA.thy "Init(RALL x. P(x)) .= (RALL x. Init(P(x)))"
   37.81 +  (fn _ => [ auto_tac (temp_css addsimps2 [Init_def]) ]);
   37.82 +
   37.83 +qed_goal "Init_ex" TLA.thy "Init(REX x. P(x)) .= (REX x. Init(P(x)))"
   37.84 +  (fn _ => [ auto_tac (temp_css addsimps2 [Init_def]) ]);
   37.85 +
   37.86 +val Init_simps = map temp_rewrite
   37.87 +                     [Init_true,Init_false,Init_not,Init_and,Init_or,
   37.88 +		      Init_imp,Init_iff,Init_all,Init_ex];
   37.89 +
   37.90 +
   37.91 +(* Temporal lemmas *)
   37.92 +
   37.93 +qed_goalw "DmdAct" TLA.thy [dmd_def,boxact_def] "(<>(F::action)) .= (<> Init F)"
   37.94 +  (fn _ => [auto_tac (temp_css addsimps2 Init_simps)]);
   37.95 +
   37.96 +
   37.97 +(* ------------------------------------------------------------------------- *)
   37.98 +(***           "Simple temporal logic": only [] and <>                     ***)
   37.99 +(* ------------------------------------------------------------------------- *)
  37.100 +section "Simple temporal logic";
  37.101 +
  37.102 +(* ------------------------ STL2 ------------------------------------------- *)
  37.103 +bind_thm("STL2", reflT);
  37.104 +bind_thm("STL2D", temp_mp STL2);
  37.105 +
  37.106 +(* The action variants. *)
  37.107 +qed_goalw "STL2b" TLA.thy [boxact_def] "[]P .-> Init P"
  37.108 +   (fn _ => [rtac STL2 1]);
  37.109 +bind_thm("STL2bD", temp_mp STL2b);
  37.110 +(* see also STL2b_pr below: "[]P .-> Init(P .& P`)" *)
  37.111 +
  37.112 +(* Dual versions for <> *)
  37.113 +qed_goalw "ImplDmd" TLA.thy [dmd_def] "F .-> <>F"
  37.114 +   (fn _ => [ auto_tac (temp_css addSDs2 [STL2D]) ]);
  37.115 +bind_thm ("ImplDmdD", temp_mp ImplDmd);
  37.116 +
  37.117 +qed_goalw "InitDmd" TLA.thy [dmd_def] "Init(P) .-> <>P"
  37.118 +   (fn _ => [ auto_tac (temp_css addsimps2 Init_simps addSDs2 [STL2bD]) ]);
  37.119 +bind_thm("InitDmdD", temp_mp InitDmd);
  37.120 +
  37.121 +
  37.122 +(* ------------------------ STL3 ------------------------------------------- *)
  37.123 +qed_goal "STL3" TLA.thy "([][]F) .= ([]F)"
  37.124 +   (fn _ => [auto_tac (temp_css addIs2 [temp_mp transT,temp_mp STL2])]);
  37.125 +
  37.126 +(* corresponding elimination rule introduces double boxes: 
  37.127 +   [| (sigma |= []F); (sigma |= [][]F) ==> PROP W |] ==> PROP W
  37.128 +*)
  37.129 +bind_thm("dup_boxE", make_elim((temp_unlift STL3) RS iffD2));
  37.130 +bind_thm("dup_boxD", (temp_unlift STL3) RS iffD1);
  37.131 +
  37.132 +(* dual versions for <> *)
  37.133 +qed_goalw "DmdDmd" TLA.thy [dmd_def] "(<><>F) .= (<>F)"
  37.134 +   (fn _ => [ auto_tac (temp_css addsimps2 [STL3]) ]);
  37.135 +bind_thm("dup_dmdE", make_elim((temp_unlift DmdDmd) RS iffD2));
  37.136 +bind_thm("dup_dmdD", (temp_unlift DmdDmd) RS iffD1);
  37.137 +
  37.138 +
  37.139 +(* ------------------------ STL4 ------------------------------------------- *)
  37.140 +qed_goal "STL4" TLA.thy "(F .-> G)  ==> ([]F .-> []G)"
  37.141 +   (fn [prem] => [Auto_tac(),
  37.142 +		  rtac ((temp_mp normalT) RS mp) 1,
  37.143 +		  REPEAT (ares_tac [prem, necT RS tempD] 1)
  37.144 +		 ]);
  37.145 +
  37.146 +(* A more practical variant as an (unlifted) elimination rule *)
  37.147 +qed_goal "STL4E" TLA.thy 
  37.148 +         "[| (sigma |= []F); F .-> G |] ==> (sigma |= []G)"
  37.149 +   (fn prems => [ REPEAT (resolve_tac (prems @ [temp_mp STL4]) 1) ]);
  37.150 +
  37.151 +(* see also STL4Edup below, which allows an auxiliary boxed formula:
  37.152 +       []A /\ F => G
  37.153 +     -----------------
  37.154 +     []A /\ []F => []G
  37.155 +*)
  37.156 +
  37.157 +(* The dual versions for <> *)
  37.158 +qed_goalw "DmdImpl" TLA.thy [dmd_def]
  37.159 +   "(F .-> G) ==> (<>F .-> <>G)"
  37.160 +   (fn [prem] => [fast_tac (temp_cs addSIs [int_mp prem] addSEs [STL4E]) 1]);
  37.161 +
  37.162 +qed_goal "DmdImplE" TLA.thy
  37.163 +   "[| (sigma |= <>F); F .-> G |] ==> (sigma |= <>G)"
  37.164 +   (fn prems => [ REPEAT (resolve_tac (prems @ [temp_mp DmdImpl]) 1) ]);
  37.165 +
  37.166 +
  37.167 +(* ------------------------ STL5 ------------------------------------------- *)
  37.168 +qed_goal "STL5" TLA.thy "([]F .& []G) .= ([](F .& G))"
  37.169 +   (fn _ => [Auto_tac(),
  37.170 +	     subgoal_tac "sigma |= [](G .-> (F .& G))" 1,
  37.171 +	     etac ((temp_mp normalT) RS mp) 1, atac 1,
  37.172 +	     ALLGOALS (fast_tac (temp_cs addSEs [STL4E]))
  37.173 +	    ]);
  37.174 +(* rewrite rule to split conjunctions under boxes *)
  37.175 +bind_thm("split_box_conj", (temp_unlift STL5) RS sym);
  37.176 +
  37.177 +(* the corresponding elimination rule allows to combine boxes in the hypotheses
  37.178 +   (NB: F and G must have the same type, i.e., both actions or temporals.)
  37.179 +*)
  37.180 +qed_goal "box_conjE" TLA.thy
  37.181 +   "[| (sigma |= []F); (sigma |= []G); (sigma |= [](F.&G)) ==> PROP R |] ==> PROP R"
  37.182 +   (fn prems => [ REPEAT (resolve_tac
  37.183 +			   (prems @ [(temp_unlift STL5) RS iffD1, conjI]) 1) ]);
  37.184 +
  37.185 +(* Define a tactic that tries to merge all boxes in an antecedent. The definition is
  37.186 +   a bit kludgy: how do you simulate "double elim-resolution"?
  37.187 +   Note: If there are boxed hypotheses of different types, the tactic may delete the 
  37.188 +         wrong formulas. We therefore also define less polymorphic tactics for
  37.189 +         temporals and actions.
  37.190 +*)
  37.191 +qed_goal "box_thin" TLA.thy "[| (sigma |= []F); PROP W |] ==> PROP W"
  37.192 +  (fn prems => [resolve_tac prems 1]);
  37.193 +
  37.194 +fun merge_box_tac i =
  37.195 +   REPEAT_DETERM (EVERY [etac box_conjE i, atac i, etac box_thin i]);
  37.196 +
  37.197 +qed_goal "temp_box_conjE" TLA.thy
  37.198 +   "[| (sigma |= [](F::temporal)); (sigma |= []G); (sigma |= [](F.&G)) ==> PROP R |] ==> PROP R"
  37.199 +   (fn prems => [ REPEAT (resolve_tac
  37.200 +			   (prems @ [(temp_unlift STL5) RS iffD1, conjI]) 1) ]);
  37.201 +qed_goal "temp_box_thin" TLA.thy "[| (sigma |= [](F::temporal)); PROP W |] ==> PROP W"
  37.202 +  (fn prems => [resolve_tac prems 1]);
  37.203 +fun merge_temp_box_tac i =
  37.204 +   REPEAT_DETERM (EVERY [etac temp_box_conjE i, atac i, etac temp_box_thin i]);
  37.205 +
  37.206 +qed_goal "act_box_conjE" TLA.thy
  37.207 +   "[| (sigma |= [](A::action)); (sigma |= []B); (sigma |= [](A.&B)) ==> PROP R |] ==> PROP R"
  37.208 +   (fn prems => [ REPEAT (resolve_tac
  37.209 +			   (prems @ [(temp_unlift STL5) RS iffD1, conjI]) 1) ]);
  37.210 +qed_goal "act_box_thin" TLA.thy "[| (sigma |= [](A::action)); PROP W |] ==> PROP W"
  37.211 +  (fn prems => [resolve_tac prems 1]);
  37.212 +fun merge_act_box_tac i =
  37.213 +   REPEAT_DETERM (EVERY [etac act_box_conjE i, atac i, etac act_box_thin i]);
  37.214 +
  37.215 +(* rewrite rule to push universal quantification through box:
  37.216 +      (sigma |= [](RALL x. F x)) = (! x. (sigma |= []F x))
  37.217 +*)
  37.218 +bind_thm("all_box", standard((temp_unlift allT) RS sym));
  37.219 +
  37.220 +
  37.221 +qed_goal "DmdOr" TLA.thy "(<>(F .| G)) .= (<>F .| <>G)"
  37.222 +   (fn _ => [auto_tac (temp_css addsimps2 [dmd_def,split_box_conj]),
  37.223 +             TRYALL (EVERY' [etac swap, 
  37.224 +                             merge_box_tac, 
  37.225 +                             fast_tac (temp_cs addSEs [STL4E])])
  37.226 +            ]);
  37.227 +
  37.228 +qed_goal "exT" TLA.thy "(REX x. <>(F x)) .= (<>(REX x. F x))"
  37.229 +   (fn _ => [ auto_tac (temp_css addsimps2 [dmd_def,temp_rewrite Not_rex,all_box]) ]);
  37.230 +
  37.231 +bind_thm("ex_dmd", standard((temp_unlift exT) RS sym));
  37.232 +	     
  37.233 +
  37.234 +qed_goal "STL4Edup" TLA.thy
  37.235 +   "!!sigma. [| (sigma |= []A); (sigma |= []F); F .& []A .-> G |] ==> (sigma |= []G)"
  37.236 +   (fn _ => [etac dup_boxE 1,
  37.237 +	     merge_box_tac 1,
  37.238 +	     etac STL4E 1,
  37.239 +	     atac 1
  37.240 +	    ]);
  37.241 +
  37.242 +qed_goalw "DmdImpl2" TLA.thy [dmd_def]
  37.243 +   "!!sigma. [| (sigma |= <>F); (sigma |= [](F .-> G)) |] ==> (sigma |= <>G)"
  37.244 +   (fn _ => [Auto_tac(),
  37.245 +	     etac notE 1,
  37.246 +	     merge_box_tac 1,
  37.247 +	     fast_tac (temp_cs addSEs [STL4E]) 1
  37.248 +	    ]);
  37.249 +
  37.250 +qed_goal "InfImpl" TLA.thy
  37.251 +   "[| (sigma |= []<>F); (sigma |= []G); F .& G .-> H |] ==> (sigma |= []<>H)"
  37.252 +   (fn [prem1,prem2,prem3] 
  37.253 +       => [cut_facts_tac [prem1,prem2] 1,
  37.254 +	   eres_inst_tac [("F","G")] dup_boxE 1,
  37.255 +	   merge_box_tac 1,
  37.256 +	   fast_tac (temp_cs addSEs [STL4E,DmdImpl2] addSIs [int_mp prem3]) 1
  37.257 +	  ]);
  37.258 +
  37.259 +(* ------------------------ STL6 ------------------------------------------- *)
  37.260 +(* Used in the proof of STL6, but useful in itself. *)
  37.261 +qed_goalw "BoxDmdT" TLA.thy [dmd_def] "[]F .& <>G .-> <>([]F .& G)"
  37.262 +  (fn _ => [ Auto_tac(),
  37.263 +             etac dup_boxE 1,
  37.264 +	     merge_box_tac 1,
  37.265 +             etac swap 1,
  37.266 +             fast_tac (temp_cs addSEs [STL4E]) 1 ]);
  37.267 +bind_thm("BoxDmd", temp_conjmp BoxDmdT);
  37.268 +
  37.269 +(* weaker than BoxDmd, but more polymorphic (and often just right) *)
  37.270 +qed_goalw "BoxDmdT2" TLA.thy [dmd_def] "<>F .& []G .-> <>(F .& G)"
  37.271 +  (fn _ => [ Auto_tac(),
  37.272 +	     merge_box_tac 1,
  37.273 +             fast_tac (temp_cs addSEs [notE,STL4E]) 1
  37.274 +	   ]);
  37.275 +
  37.276 +qed_goal "STL6" TLA.thy "<>[]F .& <>[]G .-> <>[](F .& G)"
  37.277 +  (fn _ => [auto_tac (temp_css addsimps2 [symmetric (temp_rewrite STL5)]),
  37.278 +	    etac (temp_conjimpE linT) 1, atac 1, etac thin_rl 1,
  37.279 +	    rtac ((temp_unlift DmdDmd) RS iffD1) 1,
  37.280 +	    etac disjE 1,
  37.281 +	    etac DmdImplE 1, rtac BoxDmdT 1,
  37.282 +	    (* the second subgoal needs commutativity of .&, which complicates the proof *)
  37.283 +	    etac DmdImplE 1,
  37.284 +	    Auto_tac(),
  37.285 +	    etac (temp_conjimpE BoxDmdT) 1, atac 1, etac thin_rl 1,
  37.286 +	    fast_tac (temp_cs addSEs [DmdImplE]) 1
  37.287 +	   ]);
  37.288 +
  37.289 +
  37.290 +(* ------------------------ True / False ----------------------------------------- *)
  37.291 +section "Simplification of constants";
  37.292 +
  37.293 +qed_goal "BoxTrue" TLA.thy "[](#True)"
  37.294 +   (fn _ => [ fast_tac (temp_cs addSIs [necT]) 1 ]);
  37.295 +
  37.296 +qed_goal "BoxTrue_simp" TLA.thy "([](#True)) .= #True"
  37.297 +   (fn _ => [ fast_tac (temp_cs addSIs [BoxTrue RS tempD]) 1 ]);
  37.298 +
  37.299 +qed_goal "DmdFalse_simp" TLA.thy "(<>(#False)) .= #False"
  37.300 +   (fn _ => [ auto_tac (temp_css addsimps2 [dmd_def, BoxTrue_simp]) ]);
  37.301 +
  37.302 +qed_goal "DmdTrue_simp" TLA.thy "(<>((#True)::temporal)) .= #True"
  37.303 +   (fn _ => [ fast_tac (temp_cs addSIs [ImplDmdD]) 1 ]);
  37.304 +
  37.305 +qed_goal "DmdActTrue_simp" TLA.thy "(<>((#True)::action)) .= #True"
  37.306 +   (fn _ => [ auto_tac (temp_css addsimps2 Init_simps addSIs2 [InitDmdD]) ]);
  37.307 +
  37.308 +qed_goal "BoxFalse_simp" TLA.thy "([]((#False)::temporal)) .= #False"
  37.309 +   (fn _ => [ fast_tac (temp_cs addSDs [STL2D]) 1 ]);
  37.310 +
  37.311 +qed_goal "BoxActFalse_simp" TLA.thy "([]((#False)::action)) .= #False"
  37.312 +   (fn _ => [ auto_tac (temp_css addsimps2 Init_simps addSDs2 [STL2bD]) ]);
  37.313 +
  37.314 +qed_goal "BoxConst_simp" TLA.thy "([]((#P)::temporal)) .= #P"
  37.315 +   (fn _ => [rtac tempI 1,
  37.316 +             case_tac "P" 1,
  37.317 +             auto_tac (temp_css addsimps2 [BoxTrue_simp,BoxFalse_simp])
  37.318 +            ]);
  37.319 +
  37.320 +qed_goal "BoxActConst_simp" TLA.thy "([]((#P)::action)) .= #P"
  37.321 +   (fn _ => [rtac tempI 1,
  37.322 +             case_tac "P" 1,
  37.323 +             auto_tac (temp_css addsimps2 [BoxTrue_simp,BoxActFalse_simp])
  37.324 +            ]);
  37.325 +
  37.326 +qed_goal "DmdConst_simp" TLA.thy "(<>((#P)::temporal)) .= #P"
  37.327 +   (fn _ => [rtac tempI 1,
  37.328 +             case_tac "P" 1,
  37.329 +             auto_tac (temp_css addsimps2 [DmdTrue_simp,DmdFalse_simp])
  37.330 +            ]);
  37.331 +
  37.332 +qed_goal "DmdActConst_simp" TLA.thy "(<>((#P)::action)) .= #P"
  37.333 +   (fn _ => [rtac tempI 1,
  37.334 +             case_tac "P" 1,
  37.335 +             auto_tac (temp_css addsimps2 [DmdActTrue_simp,DmdFalse_simp])
  37.336 +            ]);
  37.337 +
  37.338 +val temp_simps = map temp_rewrite
  37.339 +                  [BoxTrue_simp,DmdFalse_simp,DmdTrue_simp,
  37.340 +		   DmdActTrue_simp, BoxFalse_simp, BoxActFalse_simp,
  37.341 +		   BoxConst_simp,BoxActConst_simp,DmdConst_simp,DmdActConst_simp];
  37.342 +
  37.343 +(* Make these rewrites active by default *)
  37.344 +Addsimps temp_simps;
  37.345 +val temp_css = temp_css addsimps2 temp_simps;
  37.346 +val temp_cs = temp_cs addss (empty_ss addsimps temp_simps);
  37.347 +
  37.348 +
  37.349 +(* ------------------------ Further rewrites ----------------------------------------- *)
  37.350 +section "Further rewrites";
  37.351 +
  37.352 +qed_goalw "NotBox" TLA.thy [dmd_def] "(.~[]F) .= (<>.~F)"
  37.353 +   (fn _ => [ Auto_tac() ]);
  37.354 +
  37.355 +qed_goalw "NotDmd" TLA.thy [dmd_def] "(.~<>F) .= ([].~F)"
  37.356 +   (fn _ => [ Auto_tac () ]);
  37.357 +
  37.358 +(* These are not by default included in temp_css, because they could be harmful,
  37.359 +   e.g. []F .& .~[]F becomes []F .& <>.~F !! *)
  37.360 +val more_temp_simps =  (map temp_rewrite [STL3, DmdDmd, NotBox, NotDmd])
  37.361 +                       @ (map (fn th => (temp_unlift th) RS eq_reflection)
  37.362 +		         [NotBox, NotDmd]);
  37.363 +
  37.364 +qed_goal "BoxDmdBox" TLA.thy "([]<>[]F) .= (<>[]F)"
  37.365 +   (fn _ => [ auto_tac (temp_css addSDs2 [STL2D]),
  37.366 +              rtac ccontr 1,
  37.367 +              subgoal_tac "sigma |= <>[][]F .& <>[].~[]F" 1,
  37.368 +              etac thin_rl 1,
  37.369 +              Auto_tac(),
  37.370 +	      etac (temp_conjimpE STL6) 1, atac 1,
  37.371 +	      Asm_full_simp_tac 1,
  37.372 +	      ALLGOALS (asm_full_simp_tac (!simpset addsimps more_temp_simps))
  37.373 +	    ]);
  37.374 +
  37.375 +qed_goalw "DmdBoxDmd" TLA.thy [dmd_def] "(<>[]<>F) .= ([]<>F)"
  37.376 +  (fn _ => [auto_tac (temp_css addsimps2 [temp_rewrite (rewrite_rule [dmd_def] BoxDmdBox)])]);
  37.377 +
  37.378 +val more_temp_simps = more_temp_simps @ (map temp_rewrite [BoxDmdBox, DmdBoxDmd]);
  37.379 +
  37.380 +
  37.381 +(* ------------------------ Miscellaneous ----------------------------------- *)
  37.382 +
  37.383 +qed_goal "BoxOr" TLA.thy 
  37.384 +   "!!sigma. [| (sigma |= []F .| []G) |] ==> (sigma |= [](F .| G))"
  37.385 +   (fn _ => [ fast_tac (temp_cs addSEs [STL4E]) 1 ]);
  37.386 +
  37.387 +qed_goal "DBImplBD" TLA.thy "<>[](F::temporal) .-> []<>F"
  37.388 +  (fn _ => [Auto_tac(),
  37.389 +	    rtac ccontr 1,
  37.390 +	    auto_tac (temp_css addsimps2 more_temp_simps addEs2 [temp_conjimpE STL6])
  37.391 +	   ]);
  37.392 +
  37.393 +(* Although the script is the same, the derivation isn't polymorphic and doesn't
  37.394 +   work for other types of formulas (uses STL2).
  37.395 +*)
  37.396 +qed_goal "DBImplBDAct" TLA.thy "<>[](A::action) .-> []<>A"
  37.397 +  (fn _ => [Auto_tac(),
  37.398 +	    rtac ccontr 1,
  37.399 +	    auto_tac (temp_css addsimps2 more_temp_simps addEs2 [temp_conjimpE STL6])
  37.400 +	   ]);
  37.401 +
  37.402 +qed_goal "BoxDmdDmdBox" TLA.thy
  37.403 +   "!!sigma. [| (sigma |= []<>F); (sigma |= <>[]G) |] ==> (sigma |= []<>(F .& G))"
  37.404 +   (fn _ => [rtac ccontr 1,
  37.405 +	     rewrite_goals_tac more_temp_simps,
  37.406 +	     etac (temp_conjimpE STL6) 1, atac 1,
  37.407 +	     subgoal_tac "sigma |= <>[].~F" 1,
  37.408 +	     SELECT_GOAL (auto_tac (temp_css addsimps2 [dmd_def])) 1,
  37.409 +	     fast_tac (temp_cs addEs [DmdImplE,STL4E]) 1
  37.410 +	    ]);
  37.411 +
  37.412 +
  37.413 +(* ------------------------------------------------------------------------- *)
  37.414 +(***          TLA-specific theorems: primed formulas                       ***)
  37.415 +(* ------------------------------------------------------------------------- *)
  37.416 +section "priming";
  37.417 +
  37.418 +(* ------------------------ TLA2 ------------------------------------------- *)
  37.419 +qed_goal "STL2bD_pr" TLA.thy
  37.420 +  "!!sigma. (sigma |= []P) ==> (sigma |= Init(P .& P`))"
  37.421 +  (fn _ => [rewrite_goals_tac Init_simps,
  37.422 +	    fast_tac (temp_cs addSIs [temp_mp primeI, STL2bD]) 1]);
  37.423 +
  37.424 +(* Auxiliary lemma allows priming of boxed actions *)
  37.425 +qed_goal "BoxPrime" TLA.thy "[]P .-> [](P .& P`)"
  37.426 +  (fn _ => [Auto_tac(),
  37.427 +	    etac dup_boxE 1,
  37.428 +	    auto_tac (temp_css addsimps2 [boxact_def]
  37.429 +		               addSIs2 [STL2bD_pr] addSEs2 [STL4E])
  37.430 +	   ]);
  37.431 +
  37.432 +qed_goal "TLA2" TLA.thy "P .& P` .-> Q  ==>  []P .-> []Q"
  37.433 +  (fn prems => [fast_tac (temp_cs addSIs prems addDs [temp_mp BoxPrime] addEs [STL4E]) 1]);
  37.434 +
  37.435 +qed_goal "TLA2E" TLA.thy 
  37.436 +   "[| (sigma |= []P); P .& P` .-> Q |] ==> (sigma |= []Q)"
  37.437 +   (fn prems => [REPEAT (resolve_tac (prems @ (prems RL [temp_mp TLA2])) 1)]);
  37.438 +
  37.439 +qed_goalw "DmdPrime" TLA.thy [dmd_def] "(<>P`) .-> (<>P)"
  37.440 +   (fn _ => [ fast_tac (temp_cs addSEs [TLA2E]) 1 ]);
  37.441 +
  37.442 +
  37.443 +(* ------------------------ INV1, stable --------------------------------------- *)
  37.444 +section "stable, invariant";
  37.445 +
  37.446 +qed_goal "ind_rule" TLA.thy
  37.447 +   "[| (sigma |= []H); (sigma |= Init(P)); H .-> (Init(P) .& .~[]F .-> Init(P`) .& F) |] \
  37.448 +\   ==> (sigma |= []F)"
  37.449 +   (fn prems => [rtac ((temp_mp indT) RS mp) 1,
  37.450 +		 REPEAT (resolve_tac (prems @ (prems RL [STL4E])) 1)]);
  37.451 +		 
  37.452 +
  37.453 +qed_goalw "INV1" TLA.thy [stable_def,boxact_def] 
  37.454 +  "Init(P) .& stable(P) .-> []P"
  37.455 +  (fn _ => [auto_tac (temp_css addsimps2 Init_simps addEs2 [ind_rule])]);
  37.456 +bind_thm("INV1I", temp_conjmp INV1);
  37.457 +
  37.458 +qed_goalw "StableL" TLA.thy [stable_def]
  37.459 +   "(P .& A .-> P`) ==> ([]A .-> stable(P))"
  37.460 +   (fn [prem] => [fast_tac (temp_cs addSIs [action_mp prem] addSEs [STL4E]) 1]);
  37.461 +
  37.462 +qed_goal "Stable" TLA.thy
  37.463 +   "[| (sigma |= []A); P .& A .-> P` |] ==> (sigma |= stable P)"
  37.464 +   (fn prems => [ REPEAT (resolve_tac (prems @ [temp_mp StableL]) 1) ]);
  37.465 +
  37.466 +(* Generalization of INV1 *)
  37.467 +qed_goalw "StableBox" TLA.thy [stable_def]
  37.468 +   "!!sigma. (sigma |= stable P) ==> (sigma |= [](Init P .-> []P))"
  37.469 +   (fn _ => [etac dup_boxE 1,
  37.470 +	     auto_tac (temp_css addsimps2 [stable_def] addEs2 [STL4E, INV1I])
  37.471 +	    ]);
  37.472 +     
  37.473 +(* useful for WF2 / SF2 *)
  37.474 +qed_goal "DmdStable" TLA.thy 
  37.475 +   "!!sigma. [| (sigma |= stable P); (sigma |= <>P) |] ==> (sigma |= <>[]P)"
  37.476 +   (fn _ => [rtac DmdImpl2 1,
  37.477 +	     etac StableBox 2,
  37.478 +	     auto_tac (temp_css addsimps2 [DmdAct])
  37.479 +	    ]);
  37.480 +
  37.481 +(* ---------------- (Semi-)automatic invariant tactics ---------------------- *)
  37.482 +
  37.483 +(* inv_tac reduces goals of the form ... ==> sigma |= []P *)
  37.484 +fun inv_tac css =
  37.485 +   SELECT_GOAL
  37.486 +     (EVERY [auto_tac css,
  37.487 +             TRY (merge_box_tac 1),
  37.488 +             rtac INV1I 1, (* fail if the goal is not a box *)
  37.489 +             TRYALL (etac Stable)]);
  37.490 +
  37.491 +(* auto_inv_tac applies inv_tac and then tries to attack the subgoals;
  37.492 +   in simple cases it may be able to handle goals like MyProg .-> []Inv.
  37.493 +   In these simple cases the simplifier seems to be more useful than the
  37.494 +   auto-tactic, which applies too much propositional logic and simplifies
  37.495 +   too late.
  37.496 +*)
  37.497 +
  37.498 +fun auto_inv_tac ss =
  37.499 +  SELECT_GOAL
  37.500 +    ((inv_tac (!claset,ss) 1) THEN
  37.501 +     (TRYALL (action_simp_tac (ss addsimps [Init_def,square_def]) [] [])));
  37.502 +
  37.503 +
  37.504 +qed_goalw "unless" TLA.thy [dmd_def]
  37.505 +   "!!sigma. (sigma |= [](P .-> P` .| Q`)) ==> (sigma |= stable P .| <>Q`)"
  37.506 +   (fn _ => [action_simp_tac (!simpset) [disjCI] [] 1,
  37.507 +	     merge_box_tac 1,
  37.508 +	     fast_tac (temp_cs addSEs [Stable]) 1
  37.509 +	    ]);
  37.510 +
  37.511 +
  37.512 +(* --------------------- Recursive expansions --------------------------------------- *)
  37.513 +section "recursive expansions";
  37.514 +
  37.515 +(* Recursive expansions of [] and <>, restricted to state predicates to avoid looping *)
  37.516 +qed_goal "BoxRec" TLA.thy "([]$P) .= (Init($P) .& ([]P$))"
  37.517 +   (fn _ => [auto_tac (temp_css addSIs2 [STL2bD]),
  37.518 +	     fast_tac (temp_cs addSEs [TLA2E]) 1,
  37.519 +	     auto_tac (temp_css addsimps2 [stable_def] addSEs2 [INV1I,STL4E])
  37.520 +	    ]);
  37.521 +
  37.522 +qed_goalw "DmdRec" TLA.thy [dmd_def] "(<>$P) .= (Init($P) .| (<>P$))"
  37.523 +   (fn _ => [Auto_tac(),
  37.524 +	     etac notE 1,
  37.525 +	     SELECT_GOAL (auto_tac (temp_css addsimps2 (stable_def::Init_simps)
  37.526 +				             addIs2 [INV1I] addEs2 [STL4E])) 1,
  37.527 +	     SELECT_GOAL (auto_tac (temp_css addsimps2 Init_simps addSDs2 [STL2bD])) 1,
  37.528 +	     fast_tac (temp_cs addSEs [notE,TLA2E]) 1
  37.529 +	    ]);
  37.530 +
  37.531 +qed_goal "DmdRec2" TLA.thy
  37.532 +   "!!sigma. [| (sigma |= <>($P)); (sigma |= [](.~P$)) |] ==> (sigma |= Init($P))"
  37.533 +   (fn _ => [dtac ((temp_unlift DmdRec) RS iffD1) 1,
  37.534 +	     SELECT_GOAL (auto_tac (temp_css addsimps2 [dmd_def])) 1
  37.535 +	    ]);
  37.536 +
  37.537 +(* The "=>" part of the following is a little intricate. *)
  37.538 +qed_goal "InfinitePrime" TLA.thy "([]<>$P) .= ([]<>P$)"
  37.539 +   (fn _ => [Auto_tac(),
  37.540 +	     rtac classical 1,
  37.541 +	     rtac (temp_mp DBImplBDAct) 1,
  37.542 +	     subgoal_tac "sigma |= <>[]$P" 1,
  37.543 +	     fast_tac (temp_cs addSEs [DmdImplE,TLA2E]) 1,
  37.544 +	     subgoal_tac "sigma |= <>[](<>$P .& [].~P$)" 1,
  37.545 +	     SELECT_GOAL (auto_tac (temp_css addsimps2 [boxact_def]
  37.546 +				             addSEs2 [DmdImplE,STL4E,DmdRec2])) 1,
  37.547 +	     SELECT_GOAL (auto_tac (temp_css addSIs2 [temp_mp STL6] addsimps2 more_temp_simps)) 1,
  37.548 +	     fast_tac (temp_cs addIs [temp_mp DmdPrime] addSEs [STL4E]) 1
  37.549 +	    ]);
  37.550 +
  37.551 +(* ------------------------ fairness ------------------------------------------- *)
  37.552 +section "fairness";
  37.553 +
  37.554 +(* alternative definitions of fairness *)
  37.555 +qed_goalw "WF_alt" TLA.thy [WF_def,dmd_def] 
  37.556 +   "WF(A)_v .= (([]<>.~$(Enabled(<A>_v))) .| []<><A>_v)"
  37.557 +   (fn _ => [ fast_tac temp_cs 1 ]);
  37.558 +
  37.559 +qed_goalw "SF_alt" TLA.thy [SF_def,dmd_def]
  37.560 +   "SF(A)_v .= ((<>[].~$(Enabled(<A>_v))) .| []<><A>_v)"
  37.561 +   (fn _ => [ fast_tac temp_cs 1 ]);
  37.562 +
  37.563 +(* theorems to "box" fairness conditions *)
  37.564 +qed_goal "BoxWFI" TLA.thy
  37.565 +   "!!sigma. (sigma |= WF(A)_v) ==> (sigma |= []WF(A)_v)"
  37.566 +   (fn _ => [ auto_tac (temp_css addsimps2 (temp_rewrite WF_alt::more_temp_simps) addSIs2 [BoxOr]) ]);
  37.567 +
  37.568 +qed_goal "WF_Box" TLA.thy "([]WF(A)_v) .= WF(A)_v"
  37.569 +  (fn prems => [ fast_tac (temp_cs addSIs [BoxWFI] addSDs [STL2D]) 1 ]);
  37.570 +
  37.571 +qed_goal "BoxSFI" TLA.thy
  37.572 +   "!!sigma. (sigma |= SF(A)_v) ==> (sigma |= []SF(A)_v)"
  37.573 +   (fn _ => [ auto_tac (temp_css addsimps2 (temp_rewrite SF_alt::more_temp_simps) addSIs2 [BoxOr]) ]);
  37.574 +
  37.575 +qed_goal "SF_Box" TLA.thy "([]SF(A)_v) .= SF(A)_v"
  37.576 +  (fn prems => [ fast_tac (temp_cs addSIs [BoxSFI] addSDs [STL2D]) 1 ]);
  37.577 +
  37.578 +val more_temp_simps = more_temp_simps @ (map temp_rewrite [WF_Box, SF_Box]);
  37.579 +
  37.580 +qed_goalw "SFImplWF" TLA.thy [SF_def,WF_def]
  37.581 +  "!!sigma. (sigma |= SF(A)_v) ==> (sigma |= WF(A)_v)"
  37.582 +  (fn _ => [ fast_tac (temp_cs addSDs [temp_mp DBImplBDAct]) 1 ]);
  37.583 +
  37.584 +(* A tactic that "boxes" all fairness conditions. Apply more_temp_simps to "unbox". *)
  37.585 +val box_fair_tac = SELECT_GOAL (REPEAT (dresolve_tac [BoxWFI,BoxSFI] 1));
  37.586 +
  37.587 +
  37.588 +(* ------------------------------ leads-to ------------------------------ *)
  37.589 +
  37.590 +section "~>";
  37.591 +
  37.592 +qed_goalw "leadsto_init" TLA.thy [leadsto]
  37.593 +   "!!sigma. [| (sigma |= Init P); (sigma |= P ~> Q) |] ==> (sigma |= <>Q)"
  37.594 +   (fn _ => [ fast_tac (temp_cs addSDs [temp_mp STL2]) 1 ]);
  37.595 +
  37.596 +qed_goalw "streett_leadsto" TLA.thy [leadsto]
  37.597 +   "([]<>P .-> []<>Q) .= (<>(P ~> Q))"
  37.598 +   (fn _ => [Auto_tac(),
  37.599 +             asm_full_simp_tac (!simpset addsimps boxact_def::more_temp_simps) 1,
  37.600 +             SELECT_GOAL (auto_tac (temp_css addSEs2 [DmdImplE,STL4E] 
  37.601 +                                             addsimps2 Init_simps)) 1,
  37.602 +             SELECT_GOAL (auto_tac (temp_css addSIs2 [ImplDmdD] addSEs2 [STL4E])) 1,
  37.603 +             subgoal_tac "sigma |= []<><>Q" 1,
  37.604 +             asm_full_simp_tac (!simpset addsimps more_temp_simps) 1,
  37.605 +             rewtac (temp_rewrite DmdAct),
  37.606 +             dtac BoxDmdDmdBox 1, atac 1,
  37.607 +             auto_tac (temp_css addSEs2 [DmdImplE,STL4E])
  37.608 +            ]);
  37.609 +
  37.610 +qed_goal "leadsto_infinite" TLA.thy
  37.611 +   "!!sigma. [| (sigma |= []<>P); (sigma |= P ~> Q) |] ==> (sigma |= []<>Q)"
  37.612 +   (fn _ => [rtac ((temp_unlift streett_leadsto) RS iffD2 RS mp) 1,
  37.613 +             auto_tac (temp_css addSIs2 [ImplDmdD])
  37.614 +            ]);
  37.615 +
  37.616 +(* In particular, strong fairness is a Streett condition. The following
  37.617 +   rules are sometimes easier to use than WF2 or SF2 below.
  37.618 +*)
  37.619 +qed_goalw "leadsto_SF" TLA.thy [SF_def]
  37.620 +  "!!sigma. (sigma |= $(Enabled(<A>_v)) ~> <A>_v) ==> sigma |= SF(A)_v"
  37.621 +  (fn _ => [step_tac temp_cs 1,
  37.622 +            rtac leadsto_infinite 1,
  37.623 +            ALLGOALS atac
  37.624 +           ]);
  37.625 +
  37.626 +bind_thm("leadsto_WF", leadsto_SF RS SFImplWF);
  37.627 +
  37.628 +(* introduce an invariant into the proof of a leadsto assertion.
  37.629 +   []I => ((P ~> Q)  =  (P /\ I ~> Q))
  37.630 +*)
  37.631 +qed_goalw "INV_leadsto" TLA.thy [leadsto]
  37.632 +   "!!sigma. [| (sigma |= []I); (sigma |= (P .& I) ~> Q) |] ==> (sigma |= P ~> Q)"
  37.633 +   (fn _ => [etac STL4Edup 1, atac 1,
  37.634 +	     auto_tac (temp_css addsimps2 [Init_def] addSDs2 [STL2bD])
  37.635 +	    ]);
  37.636 +
  37.637 +qed_goalw "leadsto_classical" TLA.thy [leadsto,dmd_def]
  37.638 +   "!!sigma. (sigma |= [](Init P .& [].~Q .-> <>Q)) ==> (sigma |= P ~> Q)"
  37.639 +   (fn _ => [fast_tac (temp_cs addSEs [STL4E]) 1]);
  37.640 +
  37.641 +qed_goalw "leadsto_false" TLA.thy [leadsto]
  37.642 +  "(P ~> #False) .= ([] .~P)"
  37.643 +  (fn _ => [ auto_tac (temp_css addsimps2 boxact_def::Init_simps) ]);
  37.644 +
  37.645 +(* basic leadsto properties, cf. Unity *)
  37.646 +
  37.647 +qed_goal "ImplLeadsto" TLA.thy
  37.648 +   "!!sigma. (sigma |= [](P .-> Q)) ==> (sigma |= (P ~> Q))"
  37.649 +   (fn _ => [etac INV_leadsto 1, rewtac leadsto,
  37.650 +	     rtac (temp_unlift necT) 1,
  37.651 +	     auto_tac (temp_css addSIs2 [InitDmdD] addsimps2 [Init_def])
  37.652 +	    ]);
  37.653 +
  37.654 +qed_goal "EnsuresLeadsto" TLA.thy
  37.655 +   "A .& P .-> Q` ==> []A .-> (P ~> Q)"
  37.656 +   (fn [prem] => [auto_tac (temp_css addSEs2 [INV_leadsto]),
  37.657 +		  rewtac leadsto,
  37.658 + 		  auto_tac (temp_css addSIs2 [temp_unlift necT]),
  37.659 +		  rtac (temp_mp DmdPrime) 1, rtac InitDmdD 1,
  37.660 +		  auto_tac (action_css addsimps2 [Init_def] addSIs2 [action_mp prem])
  37.661 +		 ]);
  37.662 +
  37.663 +qed_goalw "EnsuresLeadsto2" TLA.thy [leadsto]
  37.664 +   "!!sigma. sigma |= [](P .-> Q`) ==> sigma |= P ~> Q"
  37.665 +   (fn _ => [subgoal_tac "sigma |= []Init(P .-> Q`)" 1,
  37.666 +             etac STL4E 1,
  37.667 +             auto_tac (temp_css addsimps2 boxact_def::Init_simps 
  37.668 +                                addIs2 [(temp_mp InitDmd) RS (temp_mp DmdPrime)])
  37.669 +            ]);
  37.670 +             
  37.671 +qed_goal "EnsuresInfinite" TLA.thy
  37.672 +   "[| (sigma |= []<>P); (sigma |= []A); A .& P .-> Q` |] ==> (sigma |= []<>Q)"
  37.673 +   (fn prems => [REPEAT (resolve_tac (prems @ [leadsto_infinite,
  37.674 +					       temp_mp EnsuresLeadsto]) 1)]);
  37.675 +
  37.676 +(*** Gronning's lattice rules (taken from TLP) ***)
  37.677 +section "Lattice rules";
  37.678 +
  37.679 +qed_goalw "LatticeReflexivity" TLA.thy [leadsto] "F ~> F"
  37.680 +   (fn _ => [REPEAT (resolve_tac [necT,InitDmd] 1)]);
  37.681 +
  37.682 +qed_goalw "LatticeTransitivity" TLA.thy [leadsto]
  37.683 +   "!!sigma. [| (sigma |= G ~> H); (sigma |= F ~> G) |] ==> (sigma |= F ~> H)"
  37.684 +   (fn _ => [etac dup_boxE 1,  (* [][](Init G .-> H) *)
  37.685 +	     merge_box_tac 1,
  37.686 +	     auto_tac (temp_css addSEs2 [STL4E]),
  37.687 +	     rewtac (temp_rewrite DmdAct),
  37.688 +	     subgoal_tac "sigmaa |= <><> Init H" 1,
  37.689 +	     asm_full_simp_tac (!simpset addsimps more_temp_simps) 1,
  37.690 +	     fast_tac (temp_cs addSEs [DmdImpl2]) 1
  37.691 +	    ]);
  37.692 +
  37.693 +qed_goalw "LatticeDisjunctionElim1" TLA.thy [leadsto]
  37.694 +   "!!sigma. (sigma |= (F .| G) ~> H) ==> (sigma |= F ~> H)"
  37.695 +   (fn _ => [ auto_tac (temp_css addsimps2 [Init_def] addSEs2 [STL4E]) ]);
  37.696 +
  37.697 +qed_goalw "LatticeDisjunctionElim2" TLA.thy [leadsto]
  37.698 +   "!!sigma. (sigma |= (F .| G) ~> H) ==> (sigma |= G ~> H)"
  37.699 +   (fn _ => [ auto_tac (temp_css addsimps2 [Init_def] addSEs2 [STL4E]) ]);
  37.700 +
  37.701 +qed_goalw "LatticeDisjunctionIntro" TLA.thy [leadsto]
  37.702 +   "!!sigma. [| (sigma |= F ~> H); (sigma |= G ~> H) |] ==> (sigma |= (F .| G) ~> H)"
  37.703 +   (fn _ => [merge_box_tac 1,
  37.704 +	     auto_tac (temp_css addsimps2 [Init_def] addSEs2 [STL4E])
  37.705 +	    ]);
  37.706 +
  37.707 +qed_goal "LatticeDiamond" TLA.thy
  37.708 +   "!!sigma. [| (sigma |= B ~> D); (sigma |= A ~> (B .| C)); (sigma |= C ~> D) |]  \
  37.709 +\            ==> (sigma |= A ~> D)"
  37.710 +   (fn _ => [subgoal_tac "sigma |= (B .| C) ~> D" 1,
  37.711 +	     eres_inst_tac [("G", "B .| C")] LatticeTransitivity 1,
  37.712 +	     ALLGOALS (fast_tac (temp_cs addSIs [LatticeDisjunctionIntro]))
  37.713 +	    ]);
  37.714 +
  37.715 +qed_goal "LatticeTriangle" TLA.thy
  37.716 +   "!!sigma. [| (sigma |= B ~> D); (sigma |= A ~> (B .| D)) |] ==> (sigma |= A ~> D)"
  37.717 +   (fn _ => [subgoal_tac "sigma |= (B .| D) ~> D" 1,
  37.718 +	     eres_inst_tac [("G", "B .| D")] LatticeTransitivity 1, atac 1,
  37.719 +	     auto_tac (temp_css addSIs2 [LatticeDisjunctionIntro] addIs2 [ImplLeadsto])
  37.720 +	    ]);
  37.721 +
  37.722 +(*** Lamport's fairness rules ***)
  37.723 +section "Fairness rules";
  37.724 +
  37.725 +qed_goalw "WF1" TLA.thy [leadsto]
  37.726 +   "[| P .& N  .-> P` .| Q`;   \
  37.727 +\      P .& N .& <A>_v .-> Q`;   \
  37.728 +\      P .& N .-> $(Enabled(<A>_v)) |]   \
  37.729 +\  ==> []N .& WF(A)_v .-> (P ~> Q)"
  37.730 +   (fn [prem1,prem2,prem3]
  37.731 +             => [auto_tac (temp_css addSDs2 [BoxWFI]),
  37.732 +		 etac STL4Edup 1, atac 1,
  37.733 +		 Auto_tac(),
  37.734 +		 subgoal_tac "sigmaa |= [](P .-> P` .| Q`)" 1,
  37.735 +		 auto_tac (temp_css addSDs2 [unless]),
  37.736 +		 etac (temp_conjimpE INV1) 1, atac 1,
  37.737 +		 merge_box_tac 1,
  37.738 +		 rtac STL2D 1,
  37.739 +		 rtac EnsuresInfinite 1, atac 2,
  37.740 +		 SELECT_GOAL (auto_tac (temp_css addsimps2 [WF_alt])) 1,
  37.741 +		 atac 2,
  37.742 +		 subgoal_tac "sigmaa |= [][]$(Enabled(<A>_v))" 1,
  37.743 +		 merge_box_tac 1,
  37.744 +		 SELECT_GOAL (auto_tac (temp_css addsimps2 [dmd_def])) 1,
  37.745 +		 SELECT_GOAL ((rewtac (temp_rewrite STL3)) THEN
  37.746 +			      (auto_tac (temp_css addSEs2 [STL4E] addSIs2 [action_mp prem3]))) 1,
  37.747 +		 fast_tac (action_cs addSIs [action_mp prem2]) 1,
  37.748 +		 fast_tac (temp_cs addIs [temp_mp DmdPrime]) 1,
  37.749 +		 fast_tac (temp_cs addSEs [STL4E] addSIs [action_mp prem1]) 1
  37.750 +		]);
  37.751 +
  37.752 +(* Sometimes easier to use; designed for action B rather than state predicate Q *)
  37.753 +qed_goalw "WF_leadsto" TLA.thy [leadsto]
  37.754 +   "[| N .& P .-> $Enabled (<A>_v);            \
  37.755 +\      N .& <A>_v .-> B;                  \ 
  37.756 +\      [](N .& [.~A]_v) .-> stable P  |]  \
  37.757 +\   ==> []N .& WF(A)_v .-> (P ~> B)"
  37.758 +   (fn [prem1,prem2,prem3]
  37.759 +       => [auto_tac (temp_css addSDs2 [BoxWFI]),
  37.760 +           etac STL4Edup 1, atac 1,
  37.761 +           Auto_tac(),
  37.762 +           subgoal_tac "sigmaa |= <><A>_v" 1,
  37.763 +           SELECT_GOAL (auto_tac (temp_css addSEs2 [DmdImpl2,STL4E] addSIs2 [action_mp prem2])) 1,
  37.764 +           rtac classical 1,
  37.765 +           rtac STL2D 1,
  37.766 +           auto_tac (temp_css addsimps2 WF_def::more_temp_simps addSEs2 [mp]),
  37.767 +           rtac ImplDmdD 1,
  37.768 +           rtac (temp_mp (prem1 RS STL4)) 1,
  37.769 +           auto_tac (temp_css addsimps2 [split_box_conj]),
  37.770 +           etac INV1I 1,
  37.771 +           merge_act_box_tac 1,
  37.772 +           auto_tac (temp_css addsimps2 [temp_rewrite not_angle] addSEs2 [temp_mp prem3])
  37.773 +          ]);
  37.774 +
  37.775 +qed_goalw "SF1" TLA.thy [leadsto]
  37.776 +   "[| P .& N  .-> P` .| Q`;   \
  37.777 +\      P .& N .& <A>_v .-> Q`;   \
  37.778 +\      []P .& []N .& []F .-> <>$(Enabled(<A>_v)) |]   \
  37.779 +\  ==> []N .& SF(A)_v .& []F .-> (P ~> Q)"
  37.780 +   (fn [prem1,prem2,prem3] =>
  37.781 +                [auto_tac (temp_css addSDs2 [BoxSFI]),
  37.782 +		 eres_inst_tac [("F","F")] dup_boxE 1,
  37.783 +		 merge_temp_box_tac 1,
  37.784 +		 etac STL4Edup 1, atac 1,
  37.785 +		 Auto_tac(),
  37.786 +		 subgoal_tac "sigmaa |= [](P .-> P` .| Q`)" 1,
  37.787 +		 auto_tac (temp_css addSDs2 [unless]),
  37.788 +		 etac (temp_conjimpE INV1) 1, atac 1,
  37.789 +		 merge_act_box_tac 1,
  37.790 +		 rtac STL2D 1,
  37.791 +		 rtac EnsuresInfinite 1, atac 2,
  37.792 +		 SELECT_GOAL (auto_tac (temp_css addsimps2 [SF_alt])) 1,
  37.793 +		 atac 2,
  37.794 +		 subgoal_tac "sigmaa |= []<>$(Enabled(<A>_v))" 1,
  37.795 +		 SELECT_GOAL (auto_tac (temp_css addsimps2 [dmd_def])) 1,
  37.796 +		 eres_inst_tac [("F","F")] dup_boxE 1,
  37.797 +		 etac STL4Edup 1, atac 1,
  37.798 +		 fast_tac (temp_cs addSEs [STL4E] addSIs [temp_mp prem3]) 1,
  37.799 +		 fast_tac (action_cs addSIs [action_mp prem2]) 1,
  37.800 +		 fast_tac (temp_cs addIs [temp_mp DmdPrime]) 1,
  37.801 +		 fast_tac (temp_cs addSEs [STL4E] addSIs [action_mp prem1]) 1
  37.802 +		]);
  37.803 +
  37.804 +qed_goal "WF2" TLA.thy
  37.805 +   "[| N .& <B>_f .-> <M>_g;   \
  37.806 +\      P .& P` .& <N .& A>_f .-> B;   \
  37.807 +\      P .& $(Enabled(<M>_g)) .-> $(Enabled(<A>_f));   \
  37.808 +\      [](N .& [.~B]_f) .& WF(A)_f .& []F .& <>[]($(Enabled(<M>_g))) .-> <>[]P |]   \
  37.809 +\  ==> []N .& WF(A)_f .& []F .-> WF(M)_g"
  37.810 +   (fn [prem1,prem2,prem3,prem4]
  37.811 +       => [Auto_tac(),
  37.812 +	   case_tac "sigma |= <>[]$Enabled(<M>_g)" 1,
  37.813 +	   SELECT_GOAL (auto_tac (temp_css addsimps2 [WF_def,dmd_def])) 2,
  37.814 +	   case_tac "sigma |= <>[][.~B]_f" 1,
  37.815 +	   subgoal_tac "sigma |= <>[]P" 1,
  37.816 +	   asm_full_simp_tac (!simpset addsimps [WF_def]) 1,
  37.817 +	   rtac (temp_mp (prem1 RS DmdImpl RS STL4)) 1,
  37.818 +	   eres_inst_tac [("V","sigma |= <>[][.~B]_f")] thin_rl 1,
  37.819 +	   etac (temp_conjimpE STL6) 1, atac 1,
  37.820 +	   subgoal_tac "sigma |= <>[]$Enabled(<A>_f)" 1,
  37.821 +	   dtac mp 1, atac 1,
  37.822 +	   subgoal_tac "sigma |= <>([]N .& []P .& []<><A>_f)" 1,
  37.823 +	   rtac ((temp_unlift DmdBoxDmd) RS iffD1) 1,
  37.824 +	   eres_inst_tac [("F","[]N .& []P .& []<><A>_f")] DmdImplE 1,
  37.825 +	   SELECT_GOAL (Auto_tac()) 1,
  37.826 +	   dres_inst_tac [("P","P")] (temp_mp BoxPrime) 1,
  37.827 +	   merge_act_box_tac 1,
  37.828 +	   etac InfImpl 1, atac 1,
  37.829 +	   SELECT_GOAL (auto_tac (temp_css addsimps2 [angle_def] addSIs2 [action_mp prem2])) 1,
  37.830 +	   etac BoxDmd 1,
  37.831 +	   dres_inst_tac [("F","<><A>_f"),("G","[]P")] BoxDmd 1, atac 1,
  37.832 +	   eres_inst_tac [("F","[]<><A>_f .& []P")] DmdImplE 1,
  37.833 +	   SELECT_GOAL (Auto_tac ()) 1,
  37.834 +	   rtac (temp_mp (prem3 RS STL4 RS DmdImpl)) 1,
  37.835 +	   fast_tac (temp_cs addIs [STL4E,DmdImplE]) 1,
  37.836 +	   etac (temp_conjimpE STL6) 1, atac 1,
  37.837 +	   eres_inst_tac [("V","sigma |= <>[][.~ B]_f")] thin_rl 1,
  37.838 +	   dtac BoxWFI 1,
  37.839 +	   eres_inst_tac [("F","N")] dup_boxE 1,
  37.840 +	   eres_inst_tac [("F","F")] dup_boxE 1,
  37.841 +	   merge_temp_box_tac 1,
  37.842 +	   dtac BoxDmd 1, atac 1,
  37.843 +	   eres_inst_tac [("V","sigma |= <>[]($Enabled (<M>_g) .& [.~ B]_f)")] thin_rl 1,
  37.844 +	   rtac dup_dmdD 1,
  37.845 +	   rtac (temp_mp (prem4 RS DmdImpl)) 1,
  37.846 +	   etac DmdImplE 1,
  37.847 +	   SELECT_GOAL
  37.848 +	     (auto_tac (temp_css addsimps2 [symmetric(temp_rewrite STL5), temp_rewrite STL3]
  37.849 +		                 addIs2 [(temp_unlift WF_Box) RS iffD1, temp_mp ImplDmd])) 1,
  37.850 +	   asm_full_simp_tac (!simpset addsimps (WF_def::more_temp_simps)) 1,
  37.851 +	   etac InfImpl 1, atac 1,
  37.852 +	   SELECT_GOAL (auto_tac (temp_css addSIs2 [action_mp prem1])) 1,
  37.853 +	   ALLGOALS (asm_full_simp_tac (!simpset addsimps [square_def,angle_def]))
  37.854 +	  ]);
  37.855 +
  37.856 +qed_goal "SF2" TLA.thy
  37.857 +   "[| N .& <B>_f .-> <M>_g;   \
  37.858 +\      P .& P` .& <N .& A>_f .-> B;   \
  37.859 +\      P .& $(Enabled(<M>_g)) .-> $(Enabled(<A>_f));   \
  37.860 +\      [](N .& [.~B]_f) .& SF(A)_f .& []F .& []<>($(Enabled(<M>_g))) .-> <>[]P |]   \
  37.861 +\  ==> []N .& SF(A)_f .& []F .-> SF(M)_g"
  37.862 +   (fn [prem1,prem2,prem3,prem4]
  37.863 +       => [Auto_tac(),
  37.864 +	   case_tac "sigma |= []<>$Enabled(<M>_g)" 1,
  37.865 +	   SELECT_GOAL (auto_tac (temp_css addsimps2 [SF_def,dmd_def])) 2,
  37.866 +	   case_tac "sigma |= <>[][.~B]_f" 1,
  37.867 +	   subgoal_tac "sigma |= <>[]P" 1,
  37.868 +	   asm_full_simp_tac (!simpset addsimps [SF_def]) 1,
  37.869 +	   rtac (temp_mp (prem1 RS DmdImpl RS STL4)) 1,
  37.870 +	   eres_inst_tac [("V","sigma |= <>[][.~B]_f")] thin_rl 1,
  37.871 +	   dtac BoxDmdDmdBox 1, atac 1,
  37.872 +	   subgoal_tac "sigma |= []<>$Enabled(<A>_f)" 1,
  37.873 +	   dtac mp 1, atac 1,
  37.874 +	   subgoal_tac "sigma |= <>([]N .& []P .& []<><A>_f)" 1,
  37.875 +	   rtac ((temp_unlift DmdBoxDmd) RS iffD1) 1,
  37.876 +	   eres_inst_tac [("F","[]N .& []P .& []<><A>_f")] DmdImplE 1,
  37.877 +	   SELECT_GOAL (Auto_tac()) 1,
  37.878 +	   dres_inst_tac [("P","P")] (temp_mp BoxPrime) 1,
  37.879 +	   merge_act_box_tac 1,
  37.880 +	   etac InfImpl 1, atac 1,
  37.881 +	   SELECT_GOAL (auto_tac (temp_css addsimps2 [angle_def] addSIs2 [action_mp prem2])) 1,
  37.882 +	   etac BoxDmd 1,
  37.883 +	   dres_inst_tac [("F","<><A>_f"),("G","[]P")] BoxDmd 1, atac 1,
  37.884 +	   eres_inst_tac [("F","[]<><A>_f .& []P")] DmdImplE 1,
  37.885 +	   SELECT_GOAL (Auto_tac ()) 1,
  37.886 +	   rtac (temp_mp (prem3 RS DmdImpl RS STL4)) 1,
  37.887 +	   fast_tac (temp_cs addEs [STL4E,DmdImplE]) 1,
  37.888 +	   dtac BoxSFI 1,
  37.889 +	   eres_inst_tac [("F","N")] dup_boxE 1,
  37.890 +	   eres_inst_tac [("F","F")] dup_boxE 1,
  37.891 +	   eres_inst_tac [("F","<>$Enabled (<M>_g)")] dup_boxE 1,
  37.892 +	   merge_temp_box_tac 1,
  37.893 +	   dtac (temp_conjmp BoxDmdT2) 1, atac 1,
  37.894 +	   rtac dup_dmdD 1,
  37.895 +	   rtac (temp_mp (prem4 RS DmdImpl)) 1,
  37.896 +	   SELECT_GOAL
  37.897 +	     (auto_tac (temp_css addsimps2 [symmetric(temp_rewrite STL5), temp_rewrite STL3]
  37.898 +		                 addIs2 [(temp_unlift WF_Box) RS iffD1, temp_mp ImplDmd]
  37.899 +			         addSEs2 [DmdImplE])) 1,
  37.900 +	   asm_full_simp_tac (!simpset addsimps (SF_def::more_temp_simps)) 1,
  37.901 +	   eres_inst_tac [("F",".~ [.~ B]_f")] InfImpl 1, atac 1,
  37.902 +	   SELECT_GOAL (auto_tac (temp_css addSIs2 [action_mp prem1])) 1,
  37.903 +	   ALLGOALS (asm_full_simp_tac (!simpset addsimps [square_def,angle_def]))
  37.904 +	  ]);
  37.905 +
  37.906 +(* ------------------------------------------------------------------------- *)
  37.907 +(***           Liveness proofs by well-founded orderings                   ***)
  37.908 +(* ------------------------------------------------------------------------- *)
  37.909 +section "Well-founded orderings";
  37.910 +
  37.911 +qed_goal "wf_dmd" TLA.thy
  37.912 +  "[| (wf r);  \
  37.913 +\     !!x. sigma |= [](F x .-> <>G .| <>(REX y. #((y,x):r) .& F y))   \
  37.914 +\  |] ==> sigma |= [](F x .-> <>G)"
  37.915 +  (fn prem1::prems => 
  37.916 +         [cut_facts_tac [prem1] 1,
  37.917 +          etac wf_induct 1,
  37.918 +          subgoal_tac "sigma |= []((REX y. #((y,x):r) .& F y) .-> <>G)" 1,
  37.919 +	  cut_facts_tac prems 1,
  37.920 +	  etac STL4Edup 1, atac 1,
  37.921 +	  Auto_tac(), etac swap 1, atac 1,
  37.922 +	  rtac dup_dmdD 1,
  37.923 +	  etac DmdImpl2 1, atac 1,
  37.924 +	  subgoal_tac "sigma |= [](RALL y. #((y,x):r) .& F y .-> <>G)" 1,
  37.925 +	  fast_tac (temp_cs addSEs [STL4E]) 1,
  37.926 +	  auto_tac (temp_css addsimps2 [all_box]),
  37.927 +	  etac allE 1, etac impCE 1,
  37.928 +	  rtac (temp_unlift necT) 1,
  37.929 +	  auto_tac (temp_css addSEs2 [STL4E])
  37.930 +         ]);
  37.931 +
  37.932 +(* Special case: leadsto via well-foundedness *)
  37.933 +qed_goalw "wf_leadsto" TLA.thy [leadsto]
  37.934 +  "[| (wf r);  \
  37.935 +\     !!x. sigma |= P x ~> (Q .| (REX y. #((y,x):r) .& P y))   \
  37.936 +\  |] ==> sigma |= P x ~> Q"
  37.937 +  (fn prems => [REPEAT (resolve_tac (wf_dmd::prems) 1),
  37.938 +		resolve_tac (prems RL [STL4E]) 1,
  37.939 +		auto_tac (temp_css addsimps2 [temp_rewrite DmdOr]),
  37.940 +                fast_tac temp_cs 1,
  37.941 +		etac swap 1,
  37.942 +		rewtac (temp_rewrite DmdAct),
  37.943 +		auto_tac (temp_css addsimps2 [Init_def] addSEs2 [DmdImplE])
  37.944 +	       ]);
  37.945 +
  37.946 +(* If r is well-founded, state function v cannot decrease forever *)
  37.947 +qed_goal "wf_not_box_decrease" TLA.thy
  37.948 +  "!!r. wf r ==> [][ {[v$, $v]} .: #r ]_v .-> <>[][#False]_v"
  37.949 +  (fn _ => [Auto_tac(),
  37.950 +            subgoal_tac "ALL x. (sigma |= [](Init($v .= #x) .-> <>[][#False]_v))" 1,
  37.951 +            etac allE 1,
  37.952 +            dtac STL2D 1,
  37.953 +            auto_tac (temp_css addsimps2 [Init_def]),
  37.954 +            etac wf_dmd 1,
  37.955 +            etac dup_boxE 1,
  37.956 +            etac STL4E 1,
  37.957 +            action_simp_tac (!simpset addsimps [con_abs]) [tempI] [] 1,
  37.958 +            case_tac "sigma |= <>[][#False]_v" 1,
  37.959 +            ALLGOALS Asm_full_simp_tac,
  37.960 +            rewrite_goals_tac more_temp_simps,
  37.961 +            dtac STL2D 1,
  37.962 +            subgoal_tac "sigma |= <>(REX y. #((y, xa) : r) .& ($v .= #y))" 1,
  37.963 +            SELECT_GOAL (auto_tac (temp_css addsimps2 [DmdAct,Init_def] 
  37.964 +                                            addEs2 [DmdImplE])) 1,
  37.965 +            subgoal_tac "sigma |= (stable ($v .= #xa) .| <>(REX y. #((y, xa) : r) .& $v .= #y)`)" 1,
  37.966 +            case_tac "sigma |= stable ($v .= #xa)" 1,
  37.967 +            SELECT_GOAL (auto_tac (temp_css addIs2 [temp_mp DmdPrime])) 2,
  37.968 +            SELECT_GOAL (rewrite_goals_tac ((symmetric (temp_rewrite NotBox))::action_rews)) 1,
  37.969 +            etac swap 1,
  37.970 +            subgoal_tac "sigma |= []($v .= #xa)" 1,
  37.971 +            dres_inst_tac [("P", "$v .= #xa")] (temp_mp BoxPrime) 1,
  37.972 +            SELECT_GOAL (auto_tac (temp_css addEs2 [STL4E] addsimps2 [square_def])) 1,
  37.973 +            SELECT_GOAL (auto_tac (temp_css addSIs2 [INV1I] addsimps2 [Init_def])) 1,
  37.974 +            auto_tac (temp_css addsimps2 [square_def] addSIs2 [unless] addSEs2 [STL4E])
  37.975 +           ]);
  37.976 +
  37.977 +(* "wf ?r  ==>  <>[][{[?v$, $?v]} .: #?r]_?v .-> <>[][#False]_?v" *)
  37.978 +bind_thm("wf_not_dmd_box_decrease",
  37.979 +         standard(rewrite_rule more_temp_simps (wf_not_box_decrease RS DmdImpl)));
  37.980 +
  37.981 +(* If there are infinitely many steps where v decreases w.r.t. r, then there
  37.982 +   have to be infinitely many non-stuttering steps where v doesn't decrease.
  37.983 +*)
  37.984 +qed_goal "wf_box_dmd_decrease" TLA.thy
  37.985 +  "wf r ==> []<>({[v$, $v]} .: #r) .-> []<><.~({[v$, $v]} .: #r)>_v"
  37.986 +  (fn [prem] => [Auto_tac(),
  37.987 +                 rtac ccontr 1,
  37.988 +                 asm_full_simp_tac 
  37.989 +                   (!simpset addsimps ([action_rewrite not_angle] @ more_temp_simps)) 1,
  37.990 +                 dtac (prem RS (temp_mp wf_not_dmd_box_decrease)) 1,
  37.991 +                 dtac BoxDmdDmdBox 1, atac 1,
  37.992 +                 subgoal_tac "sigma |= []<>((#False)::action)" 1,
  37.993 +                 SELECT_GOAL (Auto_tac()) 1,
  37.994 +                 etac STL4E 1,
  37.995 +                 rtac DmdImpl 1,
  37.996 +                 auto_tac (action_css addsimps2 [square_def] addSEs2 [prem RS wf_irrefl])
  37.997 +                ]);
  37.998 +
  37.999 +(* In particular, for natural numbers, if n decreases infinitely often
 37.1000 +   then it has to increase infinitely often.
 37.1001 +*)
 37.1002 +qed_goal "nat_box_dmd_decrease" TLA.thy
 37.1003 +  "!!n::nat stfun. []<>(n$ .< $n) .-> []<>($n .< n$)"
 37.1004 +  (fn _ => [Auto_tac(),
 37.1005 +            subgoal_tac "sigma |= []<><.~( {[n$,$n]} .: #less_than)>_n" 1,
 37.1006 +            etac thin_rl 1, etac STL4E 1, rtac DmdImpl 1,
 37.1007 +            SELECT_GOAL (auto_tac (!claset, !simpset addsimps [angle_def])) 1,
 37.1008 +            rtac nat_less_cases 1,
 37.1009 +            Auto_tac(),
 37.1010 +            rtac (temp_mp wf_box_dmd_decrease) 1,
 37.1011 +            auto_tac (!claset addSEs [STL4E] addSIs [DmdImpl], !simpset)
 37.1012 +           ]);
 37.1013 +
 37.1014 +(* ------------------------------------------------------------------------- *)
 37.1015 +(***           Flexible quantification over state variables                ***)
 37.1016 +(* ------------------------------------------------------------------------- *)
 37.1017 +section "Flexible quantification";
 37.1018 +
 37.1019 +qed_goal "aallI" TLA.thy 
 37.1020 +  "(!!x. base_var x ==> sigma |= F x) ==> sigma |= (AALL x. F(x))"
 37.1021 +  (fn prems => [auto_tac (temp_css addsimps2 [aall_def] addSEs2 [eexE] addSDs2 prems)]);
 37.1022 +
 37.1023 +qed_goal "aallE" TLA.thy
 37.1024 +   "[| sigma |= (AALL x. F(x));  (!!sigma. sigma |= F(x) ==> P sigma) |] \
 37.1025 +\   ==> (P sigma)::bool"
 37.1026 +   (fn prems => [cut_facts_tac prems 1,
 37.1027 +		 resolve_tac prems 1,
 37.1028 +		 rewrite_goals_tac (aall_def::intensional_rews),
 37.1029 +		 etac swap 1,
 37.1030 +		 auto_tac (temp_css addSIs2 [temp_mp eexI])
 37.1031 +		]);
 37.1032 +
 37.1033 +(* monotonicity of quantification *)
 37.1034 +qed_goal "eex_mono" TLA.thy
 37.1035 +  "[| sigma |= EEX x. F(x); !!x. F(x) .-> G(x) |] ==> sigma |= EEX x. G(x)"
 37.1036 +  (fn [min,maj] => [cut_facts_tac [min] 1,
 37.1037 +                    etac eexE 1,
 37.1038 +                    REPEAT (ares_tac (map temp_mp [eexI,maj]) 1)
 37.1039 +                   ]);
 37.1040 +
 37.1041 +qed_goal "aall_mono" TLA.thy
 37.1042 +  "[| sigma |= AALL x. F(x); !!x. F(x) .-> G(x) |] ==> sigma |= AALL x. G(x)"
 37.1043 +  (fn [min,maj] => [cut_facts_tac [min] 1,
 37.1044 +                    fast_tac (temp_cs addSIs [aallI, temp_mp maj]
 37.1045 +                                      addEs [aallE]) 1
 37.1046 +                   ]);
 37.1047 +
 37.1048 +(* ----------------------------------------------------------------------
 37.1049 +   example of a history variable: existence of a clock
 37.1050 +
 37.1051 +goal TLA.thy "(EEX h. Init($h .= #True) .& [](h$ .~= $h))";
 37.1052 +br tempI 1;
 37.1053 +br historyI 1;
 37.1054 +bws action_rews;
 37.1055 +by (TRYALL (rtac impI));
 37.1056 +by (TRYALL (etac conjE));
 37.1057 +ba 3;
 37.1058 +by (Asm_full_simp_tac 3);
 37.1059 +by (auto_tac (temp_css addSIs2 [(temp_unlift Init_true) RS iffD2, temp_unlift BoxTrue]));
 37.1060 +(** solved **)
 37.1061 +
 37.1062 +---------------------------------------------------------------------- *)
    38.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    38.2 +++ b/src/HOL/TLA/TLA.thy	Wed Oct 08 11:50:33 1997 +0200
    38.3 @@ -0,0 +1,85 @@
    38.4 +(* 
    38.5 +    File:        TLA/TLA.thy
    38.6 +    Author:      Stephan Merz
    38.7 +    Copyright:   1997 University of Munich
    38.8 +
    38.9 +    Theory Name: TLA
   38.10 +    Logic Image: HOL
   38.11 +
   38.12 +The temporal level of TLA.
   38.13 +*)
   38.14 +
   38.15 +TLA  =  Action + WF_Rel +
   38.16 +
   38.17 +types
   38.18 +    behavior
   38.19 +    temporal = "behavior form"
   38.20 +
   38.21 +arities
   38.22 +    behavior :: world
   38.23 +
   38.24 +consts
   38.25 +  (* get first 2 states of behavior *)
   38.26 +  fst_st     :: "behavior => state"
   38.27 +  snd_st     :: "behavior => state"
   38.28 +  
   38.29 +  Init       :: "action => temporal"
   38.30 +                 (* define Box and Dmd for both actions and temporals *)
   38.31 +  Box        :: "('w::world) form => temporal"      ("([](_))" [40] 40)
   38.32 +  Dmd        :: "('w::world) form => temporal"      ("(<>(_))" [40] 40)
   38.33 +  "~>"       :: "[action,action] => temporal"       (infixr 22)
   38.34 +  stable     :: "action => temporal"
   38.35 +  WF         :: "[action,'a stfun] => temporal"    ("(WF'(_')'_(_))" [0,60] 55)
   38.36 +  SF         :: "[action,'a stfun] => temporal"    ("(SF'(_')'_(_))" [0,60] 55)
   38.37 +
   38.38 +  (* Quantification over (flexible) state variables *)
   38.39 +  EEx        :: "('a stfun => temporal) => temporal"    (binder "EEX " 10)
   38.40 +  AAll       :: "('a stfun => temporal) => temporal"    (binder "AALL " 10)
   38.41 +
   38.42 +translations
   38.43 +  "sigma |= Init(A)"      == "Init A sigma"
   38.44 +  "sigma |= Box(F)"       == "Box F sigma"
   38.45 +  "sigma |= Dmd(F)"       == "Dmd F sigma"
   38.46 +  "sigma |= F ~> G"       == "op ~> F G sigma"
   38.47 +  "sigma |= stable(A)"    == "stable A sigma"
   38.48 +  "sigma |= WF(A)_v"      == "WF A v sigma"
   38.49 +  "sigma |= SF(A)_v"      == "SF A v sigma"
   38.50 +
   38.51 +rules
   38.52 +  dmd_def    "(<>F) == .~[].~F"
   38.53 +  boxact_def "([](F::action)) == ([] Init F)"
   38.54 +  leadsto    "P ~> Q == [](Init(P) .-> <>Q)"
   38.55 +  stable_def "stable P == [](P .-> P`)"
   38.56 +
   38.57 +  WF_def     "WF(A)_v == <>[] $(Enabled(<A>_v)) .-> []<><A>_v"
   38.58 +  SF_def     "SF(A)_v == []<> $(Enabled(<A>_v)) .-> []<><A>_v"
   38.59 +
   38.60 +  Init_def   "(sigma |= Init(F)) == ([[fst_st sigma, snd_st sigma]] |= F)"
   38.61 +
   38.62 +(* The following axioms are written "polymorphically", not just for temporal formulas. *)
   38.63 +  normalT    "[](F .-> G) .-> ([]F .-> []G)"
   38.64 +  reflT      "[]F .-> F"         (* F::temporal *)
   38.65 +  transT     "[]F .-> [][]F"
   38.66 +  linT       "(<>F) .& (<>G) .-> (<>(F .& <>G)) .| (<>(G .& <>F))"   (* F,G::temporal *)
   38.67 +  discT      "[](F .-> <>(.~F .& <>F)) .-> (F .-> []<>F)"
   38.68 +  primeI     "[]P .-> Init(P`)"
   38.69 +  primeE     "[](Init(P) .-> []F) .-> Init(P`) .-> (F .-> []F)"
   38.70 +  indT       "[](Init(P) .& .~[]F .-> Init(P`) .& F) .-> Init(P) .-> []F"
   38.71 +  allT       "(RALL x. [](F(x))) .= ([](RALL x. F(x)))"
   38.72 +
   38.73 +  necT       "F ==> []F"
   38.74 +
   38.75 +(* Flexible quantification: refinement mappings, history variables *)
   38.76 +  aall_def      "(AALL x. F(x)) == .~ (EEX x. .~ F(x))"
   38.77 +  eexI          "F x .-> (EEX x. F x)"
   38.78 +  historyI      "[| sigma |= Init(I); sigma |= []N;
   38.79 +                    (!!h s t. (h s = ha s t) & I [[s,t]] --> HI(h)[[s,t]]);
   38.80 +                    (!!h s t. (h t = hc s t (h s)) & N [[s,t]] --> HN(h) [[s,t]])
   38.81 +                 |] ==> sigma |= (EEX h. Init(HI(h)) .& []HN(h))"
   38.82 +  eexE          "[| sigma |= (EEX x. F x);
   38.83 +		    (!!x. [| base_var x; (sigma |= F x) |] ==> (G sigma)::bool) 
   38.84 +		 |] ==> G sigma"
   38.85 +
   38.86 +end
   38.87 +
   38.88 +ML
    39.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    39.2 +++ b/src/HOL/TLA/cladata.ML	Wed Oct 08 11:50:33 1997 +0200
    39.3 @@ -0,0 +1,56 @@
    39.4 +(*  Title:      TLA/cladata.ML
    39.5 +    Author:     Stephan Merz (mostly stolen from Isabelle/HOL)
    39.6 +
    39.7 +Setting up the classical reasoner for TLA.
    39.8 +
    39.9 +The classical prover for TLA uses a different hyp_subst_tac that substitutes 
   39.10 +somewhat more liberally for state variables. Unfortunately, this requires
   39.11 +either generating a new prover or redefining the basic proof tactics.
   39.12 +We take the latter approach, because otherwise there would be a type conflict
   39.13 +between standard HOL and TLA classical sets, and we would have to redefine
   39.14 +even more things (e.g., blast_tac), and try to keep track of which rules 
   39.15 +have been active in setting up a new default claset.
   39.16 +
   39.17 +*)
   39.18 +
   39.19 +
   39.20 +(* Generate a different hyp_subst_tac
   39.21 +   that substitutes for x(s) if s is a bound variable of "world" type. 
   39.22 +   This is useful to solve equations that contain state variables.
   39.23 +*)
   39.24 +
   39.25 +use "hypsubst.ML";           (* local version! *)
   39.26 +
   39.27 +structure ActHypsubst_Data =
   39.28 +  struct
   39.29 +  structure Simplifier = Simplifier
   39.30 +  (*Take apart an equality judgement; otherwise raise Match!*)
   39.31 +  fun dest_eq (Const("Trueprop",_) $ (Const("op =",_)  $ t $ u)) = (t,u);
   39.32 +  val eq_reflection = eq_reflection
   39.33 +  val imp_intr = impI
   39.34 +  val rev_mp = rev_mp
   39.35 +  val subst = subst
   39.36 +  val sym = sym
   39.37 +  end;
   39.38 +
   39.39 +structure ActHypsubst = ActHypsubstFun(ActHypsubst_Data);
   39.40 +open ActHypsubst;
   39.41 +
   39.42 +
   39.43 +(**
   39.44 +  Define the basic classical set and clasimpset for the action part of TLA.
   39.45 +  Add the new hyp_subst_tac to the wrapper (also for the default claset).
   39.46 +**)
   39.47 +
   39.48 +val action_cs = (HOL_cs addSIs [actionI,intI] addSEs [exE_prop] addDs [actionD,intD] 
   39.49 +                        addss !simpset) 
   39.50 +                addSaltern action_hyp_subst_tac;
   39.51 +val action_css = (action_cs, !simpset);
   39.52 +
   39.53 +
   39.54 +AddSIs [actionI,intI];
   39.55 +AddDs  [actionD,intD];
   39.56 +Addss  (!simpset);
   39.57 +
   39.58 +
   39.59 +
    40.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    40.2 +++ b/src/HOL/TLA/hypsubst.ML	Wed Oct 08 11:50:33 1997 +0200
    40.3 @@ -0,0 +1,236 @@
    40.4 +(*  Title: 	~/projects/isabelle/TLA/hypsubst.ML
    40.5 +    Authors: 	Martin D Coen, Tobias Nipkow and Lawrence C Paulson
    40.6 +    Copyright   1995  University of Cambridge
    40.7 +
    40.8 +Tactic to substitute using the assumption x=t in the rest of the subgoal,
    40.9 +and to delete that assumption.  Original version due to Martin Coen.
   40.10 +
   40.11 +This version uses the simplifier, and requires it to be already present.
   40.12 +
   40.13 +Local changes for TLA (Stephan Merz):
   40.14 +  Simplify equations like f(x) = g(y) if x,y are bound variables.
   40.15 +  This is useful for TLA if f and g are state variables. f and g may be
   40.16 +  free or bound variables, or even constants. (This may be unsafe, but
   40.17 +  we do some type checking to restrict this to state variables!)
   40.18 +
   40.19 +
   40.20 +
   40.21 +Test data:
   40.22 +
   40.23 +goal thy "!!x.[| Q(x,y,z); y=x; a=x; z=y; P(y) |] ==> P(z)";
   40.24 +goal thy "!!x.[| Q(x,y,z); z=f(x); x=z |] ==> P(z)";
   40.25 +goal thy "!!y. [| ?x=y; P(?x) |] ==> y = a";
   40.26 +goal thy "!!z. [| ?x=y; P(?x) |] ==> y = a";
   40.27 +
   40.28 +by (hyp_subst_tac 1);
   40.29 +by (bound_hyp_subst_tac 1);
   40.30 +
   40.31 +Here hyp_subst_tac goes wrong; harder still to prove P(f(f(a))) & P(f(a))
   40.32 +goal thy "P(a) --> (EX y. a=y --> P(f(a)))";
   40.33 +*)
   40.34 +
   40.35 +(*** Signatures unchanged (but renamed) from the original hypsubst.ML ***)
   40.36 +
   40.37 +signature ACTHYPSUBST_DATA =
   40.38 +  sig
   40.39 +  structure Simplifier : SIMPLIFIER
   40.40 +  val dest_eq	       : term -> term*term
   40.41 +  val eq_reflection    : thm		   (* a=b ==> a==b *)
   40.42 +  val imp_intr	       : thm		   (* (P ==> Q) ==> P-->Q *)
   40.43 +  val rev_mp	       : thm		   (* [| P;  P-->Q |] ==> Q *)
   40.44 +  val subst	       : thm		   (* [| a=b;  P(a) |] ==> P(b) *)
   40.45 +  val sym	       : thm		   (* a=b ==> b=a *)
   40.46 +  end;
   40.47 +
   40.48 +
   40.49 +signature ACTHYPSUBST =
   40.50 +  sig
   40.51 +  val action_bound_hyp_subst_tac    : int -> tactic
   40.52 +  val action_hyp_subst_tac          : int -> tactic
   40.53 +    (*exported purely for debugging purposes*)
   40.54 +  val gen_hyp_subst_tac      : bool -> int -> tactic
   40.55 +  val vars_gen_hyp_subst_tac : bool -> int -> tactic
   40.56 +  val eq_var                 : bool -> bool -> term -> int * bool
   40.57 +  val inspect_pair           : bool -> bool -> term * term -> bool
   40.58 +  val mk_eqs                 : thm -> thm list
   40.59 +  val thin_leading_eqs_tac   : bool -> int -> int -> tactic
   40.60 +  end;
   40.61 +
   40.62 +
   40.63 +functor ActHypsubstFun(Data: ACTHYPSUBST_DATA): ACTHYPSUBST = 
   40.64 +struct
   40.65 +
   40.66 +fun STATE tacfun st = tacfun st st;
   40.67 +
   40.68 +
   40.69 +local open Data in
   40.70 +
   40.71 +exception EQ_VAR;
   40.72 +
   40.73 +fun loose (i,t) = 0 mem add_loose_bnos(t,i,[]);
   40.74 +
   40.75 +local val odot = ord"."
   40.76 +in
   40.77 +(*Simplifier turns Bound variables to dotted Free variables: 
   40.78 +  change it back (any Bound variable will do)
   40.79 +*)
   40.80 +fun contract t =
   40.81 +    case Pattern.eta_contract t of
   40.82 +	Free(a,T) => if (ord a = odot) then Bound 0 else Free(a,T)
   40.83 +      | Free at $ Free(b,T) => Free at $
   40.84 +                               (if ord b = odot then Bound 0 else Free(b,T))
   40.85 +      | t'        => t'
   40.86 +end;
   40.87 +
   40.88 +fun has_vars t = maxidx_of_term t <> ~1;
   40.89 +
   40.90 +(* Added for TLA version.
   40.91 +   Is type ty the type of a state variable? Only then do we substitute
   40.92 +   in applications. This function either returns true or raises Match.
   40.93 +*)
   40.94 +fun is_stvar (Type("fun", Type("state",[])::_)) = true;
   40.95 +
   40.96 +
   40.97 +(*If novars then we forbid Vars in the equality.
   40.98 +  If bnd then we only look for Bound (or dotted Free) variables to eliminate. 
   40.99 +  When can we safely delete the equality?
  40.100 +    Not if it equates two constants; consider 0=1.
  40.101 +    Not if it resembles x=t[x], since substitution does not eliminate x.
  40.102 +    Not if it resembles ?x=0; another goal could instantiate ?x to Suc(i)
  40.103 +    Not if it involves a variable free in the premises, 
  40.104 +        but we can't check for this -- hence bnd and bound_hyp_subst_tac
  40.105 +  Prefer to eliminate Bound variables if possible.
  40.106 +  Result:  true = use as is,  false = reorient first *)
  40.107 +fun inspect_pair bnd novars (t,u) =
  40.108 +  case (contract t, contract u) of
  40.109 +       (Bound i, _) => if loose(i,u) orelse novars andalso has_vars u 
  40.110 +		       then raise Match 
  40.111 +		       else true		(*eliminates t*)
  40.112 +     | (_, Bound i) => if loose(i,t) orelse novars andalso has_vars t  
  40.113 +		       then raise Match 
  40.114 +		       else false		(*eliminates u*)
  40.115 +     | (Free _, _) =>  if bnd orelse Logic.occs(t,u) orelse  
  40.116 +		          novars andalso has_vars u  
  40.117 +		       then raise Match 
  40.118 +		       else true		(*eliminates t*)
  40.119 +     | (_, Free _) =>  if bnd orelse Logic.occs(u,t) orelse  
  40.120 +		          novars andalso has_vars t 
  40.121 +		       then raise Match 
  40.122 +		       else false		(*eliminates u*)
  40.123 +     | (Free(_,ty) $ (Bound _), _) => 
  40.124 +                       if bnd orelse 
  40.125 +                          novars andalso has_vars u
  40.126 +                       then raise Match 
  40.127 +                       else is_stvar(ty)        (* changed for TLA *)
  40.128 +     | (_, Free(_,ty) $ (Bound _)) => 
  40.129 +                       if bnd orelse 
  40.130 +                          novars andalso has_vars t
  40.131 +                       then raise Match 
  40.132 +                       else not(is_stvar(ty))   (* changed for TLA *)
  40.133 +     | ((Bound _) $ (Bound _), _) => (* can't check for types here *)
  40.134 +                       if bnd orelse 
  40.135 +                          novars andalso has_vars u
  40.136 +                       then raise Match 
  40.137 +                       else true
  40.138 +     | (_, (Bound _) $ (Bound _)) => (* can't check for types here *)
  40.139 +                       if bnd orelse 
  40.140 +                          novars andalso has_vars t
  40.141 +                       then raise Match 
  40.142 +                       else false
  40.143 +     | (Const(_,ty) $ (Bound _), _) => 
  40.144 +                       if bnd orelse 
  40.145 +                          novars andalso has_vars u
  40.146 +                       then raise Match 
  40.147 +                       else is_stvar(ty)        (* changed for TLA *)
  40.148 +     | (_, Const(_,ty) $ (Bound _)) => 
  40.149 +                       if bnd orelse
  40.150 +                          novars andalso has_vars t
  40.151 +                       then raise Match 
  40.152 +                       else not(is_stvar(ty))   (* changed for TLA *)
  40.153 +     | _ => raise Match;
  40.154 +
  40.155 +(*Locates a substitutable variable on the left (resp. right) of an equality
  40.156 +   assumption.  Returns the number of intervening assumptions. *)
  40.157 +fun eq_var bnd novars =
  40.158 +  let fun eq_var_aux k (Const("all",_) $ Abs(_,_,t)) = eq_var_aux k t
  40.159 +	| eq_var_aux k (Const("==>",_) $ A $ B) = 
  40.160 +	      ((k, inspect_pair bnd novars (dest_eq A))
  40.161 +		      (*Exception comes from inspect_pair or dest_eq*)
  40.162 +	       handle Match => eq_var_aux (k+1) B)
  40.163 +	| eq_var_aux k _ = raise EQ_VAR
  40.164 +  in  eq_var_aux 0  end;
  40.165 +
  40.166 +(*We do not try to delete ALL equality assumptions at once.  But
  40.167 +  it is easy to handle several consecutive equality assumptions in a row.
  40.168 +  Note that we have to inspect the proof state after doing the rewriting,
  40.169 +  since e.g. z=f(x); x=z changes to z=f(x); x=f(x) and the second equality
  40.170 +  must NOT be deleted.  Tactic must rotate or delete m assumptions.
  40.171 +*)
  40.172 +fun thin_leading_eqs_tac bnd m i = STATE(fn state =>
  40.173 +    let fun count []      = 0
  40.174 +	  | count (A::Bs) = ((inspect_pair bnd true (dest_eq A);  
  40.175 +			      1 + count Bs)
  40.176 +                             handle Match => 0)
  40.177 +	val (_,_,Bi,_) = dest_state(state,i)
  40.178 +        val j = Int.min (m, count (Logic.strip_assums_hyp Bi))
  40.179 +    in  REPEAT_DETERM_N j     (etac thin_rl i)   THEN
  40.180 +        REPEAT_DETERM_N (m-j) (etac revcut_rl i)
  40.181 +    end);
  40.182 +
  40.183 +(*For the simpset.  Adds ALL suitable equalities, even if not first!
  40.184 +  No vars are allowed here, as simpsets are built from meta-assumptions*)
  40.185 +fun mk_eqs th = 
  40.186 +    [ if inspect_pair false false (Data.dest_eq (#prop (rep_thm th)))
  40.187 +      then th RS Data.eq_reflection
  40.188 +      else symmetric(th RS Data.eq_reflection) (*reorient*) ] 
  40.189 +    handle Match => [];  (*Exception comes from inspect_pair or dest_eq*)
  40.190 +
  40.191 +local open Simplifier 
  40.192 +in
  40.193 +
  40.194 +  val hyp_subst_ss = empty_ss setmksimps mk_eqs
  40.195 +
  40.196 +  (*Select a suitable equality assumption and substitute throughout the subgoal
  40.197 +    Replaces only Bound variables if bnd is true*)
  40.198 +  fun gen_hyp_subst_tac bnd i = DETERM (STATE(fn state =>
  40.199 +	let val (_,_,Bi,_) = dest_state(state,i)
  40.200 +	    val n = length(Logic.strip_assums_hyp Bi) - 1
  40.201 +	    val (k,_) = eq_var bnd true Bi
  40.202 +	in 
  40.203 +	   EVERY [REPEAT_DETERM_N k (etac revcut_rl i),
  40.204 +		  asm_full_simp_tac hyp_subst_ss i,
  40.205 +		  etac thin_rl i,
  40.206 +		  thin_leading_eqs_tac bnd (n-k) i]
  40.207 +	end
  40.208 +	handle THM _ => no_tac | EQ_VAR => no_tac));
  40.209 +
  40.210 +end;
  40.211 +
  40.212 +val ssubst = standard (sym RS subst);
  40.213 +
  40.214 +(*Old version of the tactic above -- slower but the only way
  40.215 +  to handle equalities containing Vars.*)
  40.216 +fun vars_gen_hyp_subst_tac bnd i = DETERM (STATE(fn state =>
  40.217 +      let val (_,_,Bi,_) = dest_state(state,i)
  40.218 +	  val n = length(Logic.strip_assums_hyp Bi) - 1
  40.219 +	  val (k,symopt) = eq_var bnd false Bi
  40.220 +      in 
  40.221 +	 EVERY [REPEAT_DETERM_N k (etac rev_mp i),
  40.222 +		etac revcut_rl i,
  40.223 +		REPEAT_DETERM_N (n-k) (etac rev_mp i),
  40.224 +		etac (if symopt then ssubst else subst) i,
  40.225 +		REPEAT_DETERM_N n (rtac imp_intr i)]
  40.226 +      end
  40.227 +      handle THM _ => no_tac | EQ_VAR => no_tac));
  40.228 +
  40.229 +(*Substitutes for Free or Bound variables*)
  40.230 +val action_hyp_subst_tac = 
  40.231 +    (* gen_hyp_subst_tac false ORELSE' *) vars_gen_hyp_subst_tac false;
  40.232 +
  40.233 +(*Substitutes for Bound variables only -- this is always safe*)
  40.234 +val action_bound_hyp_subst_tac = 
  40.235 +    (* gen_hyp_subst_tac true ORELSE' *) vars_gen_hyp_subst_tac true;
  40.236 +
  40.237 +end
  40.238 +end;
  40.239 +