updated (Stephan Merz);
authorwenzelm
Mon Feb 08 13:02:56 1999 +0100 (1999-02-08)
changeset 6255db63752140c7
parent 6254 f6335d319e9f
child 6256 e17fb80b3ce1
updated (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/Buffer/index.html
src/HOL/TLA/Inc/Inc.ML
src/HOL/TLA/Inc/Inc.thy
src/HOL/TLA/Init.ML
src/HOL/TLA/Init.thy
src/HOL/TLA/IntLemmas.ML
src/HOL/TLA/Intensional.ML
src/HOL/TLA/Intensional.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/ROOT.ML
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 --- a/src/HOL/TLA/Action.ML	Mon Feb 08 13:02:42 1999 +0100
     1.2 +++ b/src/HOL/TLA/Action.ML	Mon Feb 08 13:02:56 1999 +0100
     1.3 @@ -6,351 +6,253 @@
     1.4  Lemmas and tactics for TLA actions.
     1.5  *)
     1.6  
     1.7 -val act_rews = [pairSF_def RS eq_reflection,unl_before,unl_after,unchanged_def,
     1.8 -                pr_con,pr_before,pr_lift,pr_lift2,pr_lift3,pr_all,pr_ex];
     1.9 +(* The following assertion specializes "intI" for any world type 
    1.10 +   which is a pair, not just for "state * state".
    1.11 +*)
    1.12 +qed_goal "actionI" Action.thy "(!!s t. (s,t) |= A) ==> |- A"
    1.13 +  (fn [prem] => [REPEAT (resolve_tac [prem,intI,prod_induct] 1)]);
    1.14 +
    1.15 +qed_goal "actionD" Action.thy "|- A ==> (s,t) |= A"
    1.16 +  (fn [prem] => [rtac (prem RS intD) 1]);
    1.17 +
    1.18 +local
    1.19 +  fun prover s = prove_goal Action.thy s 
    1.20 +                    (fn _ => [rtac actionI 1, 
    1.21 +                              rewrite_goals_tac (unl_after::intensional_rews),
    1.22 +                              rtac refl 1])
    1.23 +in
    1.24 +  val pr_rews = map (int_rewrite o prover)
    1.25 +    [ "|- (#c)` = #c",
    1.26 +      "|- f<x>` = f<x`>",
    1.27 +      "|- f<x,y>` = f<x`,y`>",
    1.28 +      "|- f<x,y,z>` = f<x`,y`,z`>",
    1.29 +      "|- (! x. P x)` = (! x. (P x)`)",
    1.30 +      "|- (? x. P x)` = (? x. (P x)`)"
    1.31 +    ]
    1.32 +end;
    1.33 +
    1.34 +val act_rews = [unl_before,unl_after,unchanged_def] @ pr_rews;
    1.35 +Addsimps act_rews;
    1.36  
    1.37  val action_rews = act_rews @ intensional_rews;
    1.38  
    1.39 -qed_goal "actionI" Action.thy "(!!s t. ([[s,t]] |= A)) ==> A"
    1.40 -  (fn [prem] => [REPEAT (resolve_tac [prem,intI,state2_ext] 1)]);
    1.41 -
    1.42 -qed_goal "actionD" Action.thy "A ==> ([[s,t]] |= A)"
    1.43 -  (fn [prem] => [REPEAT (resolve_tac [prem,intD] 1)]);
    1.44 -
    1.45 -
    1.46 -
    1.47  (* ================ Functions to "unlift" action theorems into HOL rules ================ *)
    1.48  
    1.49 -(* Basic unlifting introduces a world parameter and applies basic rewrites, e.g.
    1.50 -   A .= B    gets   ([[s,t]] |= A) = ([[s,t]] |= B)
    1.51 -   A .-> B   gets   ([[s,t]] |= A) --> ([[s,t]] |= B)
    1.52 +(* The following functions are specialized versions of the corresponding
    1.53 +   functions defined in Intensional.ML in that they introduce a
    1.54 +   "world" parameter of the form (s,t) and apply additional rewrites.
    1.55  *)
    1.56 -fun action_unlift th = rewrite_rule action_rews (th RS actionD);
    1.57 -
    1.58 -(* A .-> B   becomes   A [[s,t]] ==> B [[s,t]] *)
    1.59 -fun action_mp th = zero_var_indexes ((action_unlift th) RS mp);
    1.60 +fun action_unlift th = 
    1.61 +    (rewrite_rule action_rews (th RS actionD)) 
    1.62 +    handle _ => int_unlift th;
    1.63  
    1.64 -(* A .-> B   becomes   [| A[[s,t]]; B[[s,t]] ==> R |] ==> R 
    1.65 -   so that it can be used as an elimination rule
    1.66 -*)
    1.67 -fun action_impE th = zero_var_indexes ((action_unlift th) RS impE);
    1.68 +(* Turn  |- A = B  into meta-level rewrite rule  A == B *)
    1.69 +val action_rewrite = int_rewrite;
    1.70  
    1.71 -(* A .& B .-> C  becomes  [| A[[s,t]]; B[[s,t]] |] ==> C[[s,t]] *)
    1.72 -fun action_conjmp th = zero_var_indexes (conjI RS (action_mp th));
    1.73 -
    1.74 -(* A .& B .-> C  becomes  [| A[[s,t]]; B[[s,t]]; (C[[s,t]] ==> R) |] ==> R *)
    1.75 -fun action_conjimpE th = zero_var_indexes (conjI RS (action_impE th));
    1.76 -
    1.77 -(* Turn  A .= B  into meta-level rewrite rule  A == B *)
    1.78 -fun action_rewrite th = (rewrite_rule action_rews (th RS inteq_reflection));
    1.79 +fun action_use th =
    1.80 +    case (concl_of th) of
    1.81 +      Const _ $ (Const ("Intensional.Valid", _) $ _) =>
    1.82 +              ((flatten (action_unlift th)) handle _ => th)
    1.83 +    | _ => th;
    1.84  
    1.85  (* ===================== Update simpset and classical prover ============================= *)
    1.86  
    1.87 -(* Make the simplifier use action_unlift rather than int_unlift 
    1.88 +(***
    1.89 +(* Make the simplifier use action_use rather than int_use
    1.90     when action simplifications are added.
    1.91  *)
    1.92 -fun maybe_unlift th =
    1.93 -    (case concl_of th of
    1.94 -         Const("Intensional.TrueInt",_) $ p 
    1.95 -           => (action_unlift th
    1.96 -                  handle _ => int_unlift th)
    1.97 -       | _ => th);
    1.98 -
    1.99 -simpset_ref() := simpset() setmksimps ((mksimps mksimps_pairs) o maybe_unlift);
   1.100 -
   1.101 -(* make act_rews be always active -- intensional_rews has been added before *)
   1.102 -Addsimps act_rews;
   1.103 -
   1.104 -use "cladata.ML";        (* local version! *)
   1.105 -
   1.106 -(* ================================ action_simp_tac ================================== *)
   1.107 -
   1.108 -(* A dumb simplification tactic with just a little first-order logic:
   1.109 -   should plug in only "very safe" rules that can be applied blindly.
   1.110 -   Note that it applies whatever simplifications are currently active.
   1.111 -*)
   1.112 -fun action_simp_tac ss intros elims i =
   1.113 -    (asm_full_simp_tac 
   1.114 -         (ss setloop ((resolve_tac (intros @ [refl,impI,conjI,actionI,allI]))
   1.115 -		      ORELSE' (eresolve_tac (elims @ [conjE,disjE,exE_prop]))))
   1.116 -         i);
   1.117 -(* default version without additional plug-in rules *)
   1.118 -fun Action_simp_tac i = (action_simp_tac (simpset()) [] [] i);
   1.119 -
   1.120 -
   1.121 -(* ==================== Simplification of abstractions ==================== *)
   1.122 -
   1.123 -(* Somewhat obscure simplifications, rarely necessary to get rid
   1.124 -   of abstractions that may be introduced by higher-order unification.
   1.125 -*)
   1.126  
   1.127 -qed_goal "pr_con_abs" Action.thy "(%w. c)` .= #c"
   1.128 -  (fn _ => [rtac actionI 1,
   1.129 -            rewrite_goals_tac (con_abs::action_rews),
   1.130 -            rtac refl 1
   1.131 -           ]);
   1.132 -
   1.133 -qed_goal "pr_lift_abs" Action.thy "(%w. f(x w))` .= f[x`]"
   1.134 -  (fn _ => [rtac actionI 1,
   1.135 -              (* give all rewrites to the engine and it loops! *)
   1.136 -            rewrite_goals_tac intensional_rews,
   1.137 -            rewtac lift_abs,
   1.138 -            rewtac pr_lift,
   1.139 -            rewtac unl_lift,
   1.140 -            rtac refl 1
   1.141 -           ]);
   1.142 -
   1.143 -qed_goal "pr_lift2_abs" Action.thy "(%w. f(x w) (y w))` .= f[x`,y`]"
   1.144 -  (fn _ => [rtac actionI 1,
   1.145 -            rewrite_goals_tac intensional_rews,
   1.146 -            rewtac lift2_abs,
   1.147 -            rewtac pr_lift2,
   1.148 -            rewtac unl_lift2,
   1.149 -            rtac refl 1
   1.150 -           ]);
   1.151 -
   1.152 -qed_goal "pr_lift2_abs_con1" Action.thy "(%w. f x (y w))` .= f[#x, y`]"
   1.153 -  (fn _ => [rtac actionI 1,
   1.154 -            rewrite_goals_tac intensional_rews,
   1.155 -            rewtac lift2_abs_con1,
   1.156 -            rewtac pr_lift2,
   1.157 -            rewtac unl_lift2,
   1.158 -            rewtac pr_con,
   1.159 -            rewtac unl_con,
   1.160 -            rtac refl 1
   1.161 -           ]);
   1.162 -
   1.163 -qed_goal "pr_lift2_abs_con2" Action.thy "(%w. f (x w) y)` .= f[x`, #y]"
   1.164 -  (fn _ => [rtac actionI 1,
   1.165 -            rewrite_goals_tac intensional_rews,
   1.166 -            rewtac lift2_abs_con2,
   1.167 -            rewtac pr_lift2,
   1.168 -            rewtac unl_lift2,
   1.169 -            rewtac pr_con,
   1.170 -            rewtac unl_con,
   1.171 -            rtac refl 1
   1.172 -           ]);
   1.173 -
   1.174 -qed_goal "pr_lift3_abs" Action.thy "(%w. f(x w) (y w) (z w))` .= f[x`,y`,z`]"
   1.175 -  (fn _ => [rtac actionI 1,
   1.176 -            rewrite_goals_tac intensional_rews,
   1.177 -            rewtac lift3_abs,
   1.178 -            rewtac pr_lift3,
   1.179 -            rewtac unl_lift3,
   1.180 -            rtac refl 1
   1.181 -           ]);
   1.182 +let
   1.183 +  val ss = simpset_ref()
   1.184 +  fun try_rewrite th = 
   1.185 +      (action_rewrite th) handle _ => (action_use th) handle _ => th
   1.186 +in
   1.187 +  ss := !ss setmksimps ((mksimps mksimps_pairs) o try_rewrite)
   1.188 +end;
   1.189 +***)
   1.190  
   1.191 -qed_goal "pr_lift3_abs_con1" Action.thy "(%w. f x (y w) (z w))` .= f[#x, y`, z`]"
   1.192 -  (fn _ => [rtac actionI 1,
   1.193 -            rewrite_goals_tac intensional_rews,
   1.194 -            rewtac lift3_abs_con1,
   1.195 -            rewtac pr_lift3,
   1.196 -            rewtac unl_lift3,
   1.197 -            rewtac pr_con,
   1.198 -            rewtac unl_con,
   1.199 -            rtac refl 1
   1.200 -           ]);
   1.201 -
   1.202 -qed_goal "pr_lift3_abs_con2" Action.thy "(%w. f (x w) y (z w))` .= f[x`, #y, z`]"
   1.203 -  (fn _ => [rtac actionI 1,
   1.204 -            rewrite_goals_tac intensional_rews,
   1.205 -            rewtac lift3_abs_con2,
   1.206 -            rewtac pr_lift3,
   1.207 -            rewtac unl_lift3,
   1.208 -            rewtac pr_con,
   1.209 -            rewtac unl_con,
   1.210 -            rtac refl 1
   1.211 -           ]);
   1.212 -
   1.213 -qed_goal "pr_lift3_abs_con3" Action.thy "(%w. f (x w) (y w) z)` .= f[x`, y`, #z]"
   1.214 -  (fn _ => [rtac actionI 1,
   1.215 -            rewrite_goals_tac intensional_rews,
   1.216 -            rewtac lift3_abs_con3,
   1.217 -            rewtac pr_lift3,
   1.218 -            rewtac unl_lift3,
   1.219 -            rewtac pr_con,
   1.220 -            rewtac unl_con,
   1.221 -            rtac refl 1
   1.222 -           ]);
   1.223 -
   1.224 -qed_goal "pr_lift3_abs_con12" Action.thy "(%w. f x y (z w))` .= f[#x, #y, z`]"
   1.225 -  (fn _ => [rtac actionI 1,
   1.226 -            rewrite_goals_tac intensional_rews,
   1.227 -            rewtac lift3_abs_con12,
   1.228 -            rewtac pr_lift3,
   1.229 -            rewtac unl_lift3,
   1.230 -            rewtac pr_con,
   1.231 -            rewtac unl_con,
   1.232 -            rtac refl 1
   1.233 -           ]);
   1.234 -
   1.235 -qed_goal "pr_lift3_abs_con13" Action.thy "(%w. f x (y w) z)` .= f[#x, y`, #z]"
   1.236 -  (fn _ => [rtac actionI 1,
   1.237 -            rewrite_goals_tac intensional_rews,
   1.238 -            rewtac lift3_abs_con13,
   1.239 -            rewtac pr_lift3,
   1.240 -            rewtac unl_lift3,
   1.241 -            rewtac pr_con,
   1.242 -            rewtac unl_con,
   1.243 -            rtac refl 1
   1.244 -           ]);
   1.245 -
   1.246 -qed_goal "pr_lift3_abs_con23" Action.thy "(%w. f (x w) y z)` .= f[x`, #y, #z]"
   1.247 -  (fn _ => [rtac actionI 1,
   1.248 -            rewrite_goals_tac intensional_rews,
   1.249 -            rewtac lift3_abs_con23,
   1.250 -            rewtac pr_lift3,
   1.251 -            rewtac unl_lift3,
   1.252 -            rewtac pr_con,
   1.253 -            rewtac unl_con,
   1.254 -            rtac refl 1
   1.255 -           ]);
   1.256 -
   1.257 -(* We don't add these as default rewrite rules, because they are
   1.258 -   rarely needed and may slow down automatic proofs.
   1.259 -*)
   1.260 -val pr_abs_rews = map (fn th => th RS inteq_reflection) 
   1.261 -                      [pr_con_abs,
   1.262 -                       pr_lift_abs,pr_lift2_abs,pr_lift2_abs_con1,pr_lift2_abs_con2,
   1.263 -                       pr_lift3_abs,pr_lift3_abs_con1,pr_lift3_abs_con2,pr_lift3_abs_con3,
   1.264 -                       pr_lift3_abs_con12,pr_lift3_abs_con13,pr_lift3_abs_con23];
   1.265 +AddSIs [actionI];
   1.266 +AddDs  [actionD];
   1.267  
   1.268  (* =========================== square / angle brackets =========================== *)
   1.269  
   1.270  qed_goalw "idle_squareI" Action.thy [square_def]
   1.271 -   "!!s t. ([[s,t]] |= unchanged v) ==> ([[s,t]] |= [A]_v)"
   1.272 -   (fn _ => [ Auto_tac ]);
   1.273 +   "!!s t. (s,t) |= unchanged v ==> (s,t) |= [A]_v"
   1.274 +   (fn _ => [ Asm_full_simp_tac 1 ]);
   1.275  
   1.276  qed_goalw "busy_squareI" Action.thy [square_def]
   1.277 -   "!!s t. ([[s,t]] |= A) ==> ([[s,t]] |= [A]_v)"
   1.278 -   (fn _ => [ Auto_tac ]);
   1.279 +   "!!s t. (s,t) |= A ==> (s,t) |= [A]_v"
   1.280 +   (fn _ => [ Asm_simp_tac 1 ]);
   1.281 +
   1.282 +qed_goal "squareE" Action.thy
   1.283 +  "[| (s,t) |= [A]_v; A (s,t) ==> B (s,t); v t = v s ==> B (s,t) |] ==> B (s,t)"
   1.284 +  (fn prems => [cut_facts_tac prems 1,
   1.285 +                rewrite_goals_tac (square_def::action_rews),
   1.286 +                etac disjE 1,
   1.287 +                REPEAT (eresolve_tac prems 1)]);
   1.288 +
   1.289 +qed_goalw "squareCI" Action.thy (square_def::action_rews)
   1.290 +  "[| v t ~= v s ==> A (s,t) |] ==> (s,t) |= [A]_v"
   1.291 +  (fn prems => [rtac disjCI 1,
   1.292 +                eresolve_tac prems 1]);
   1.293 +
   1.294 +qed_goalw "angleI" Action.thy [angle_def]
   1.295 +  "!!s t. [| A (s,t); v t ~= v s |] ==> (s,t) |= <A>_v"
   1.296 +  (fn _ => [ Asm_simp_tac 1 ]);
   1.297  
   1.298 -qed_goalw "square_simulation" Action.thy [square_def]
   1.299 -   "[| unchanged f .& .~B .-> unchanged g;   \
   1.300 -\      A .& .~unchanged g .-> B              \
   1.301 -\   |] ==> [A]_f .-> [B]_g"
   1.302 -   (fn [p1,p2] => [Auto_tac,
   1.303 -                   etac (action_conjimpE p2) 1,
   1.304 -                   etac swap 3, etac (action_conjimpE p1) 3,
   1.305 -                   ALLGOALS atac
   1.306 -                  ]);
   1.307 -                   
   1.308 +qed_goalw "angleE" Action.thy (angle_def::action_rews)
   1.309 +  "[| (s,t) |= <A>_v; [| A (s,t); v t ~= v s |] ==> R |] ==> R"
   1.310 +  (fn prems => [cut_facts_tac prems 1,
   1.311 +                etac conjE 1,
   1.312 +                REPEAT (ares_tac prems 1)]);
   1.313 +
   1.314 +AddIs [angleI, squareCI];
   1.315 +AddEs [angleE, squareE];
   1.316 +
   1.317 +qed_goal "square_simulation" Action.thy
   1.318 +   "!!f. [| |- unchanged f & ~B --> unchanged g;   \
   1.319 +\           |- A & ~unchanged g --> B              \
   1.320 +\        |] ==> |- [A]_f --> [B]_g"
   1.321 +   (fn _ => [Clarsimp_tac 1,
   1.322 +             etac squareE 1,
   1.323 +             auto_tac (claset(), simpset() addsimps [square_def])
   1.324 +            ]);
   1.325 +
   1.326  qed_goalw "not_square" Action.thy [square_def,angle_def]
   1.327 -   "(.~ [A]_v) .= <.~A>_v"
   1.328 +   "|- (~ [A]_v) = <~A>_v"
   1.329     (fn _ => [ Auto_tac ]);
   1.330  
   1.331  qed_goalw "not_angle" Action.thy [square_def,angle_def]
   1.332 -   "(.~ <A>_v) .= [.~A]_v"
   1.333 +   "|- (~ <A>_v) = [~A]_v"
   1.334     (fn _ => [ Auto_tac ]);
   1.335  
   1.336  (* ============================== Facts about ENABLED ============================== *)
   1.337  
   1.338 -qed_goalw "enabledI" Action.thy [enabled_def]
   1.339 -  "A [[s,t]] ==> (Enabled A) s"
   1.340 -  (fn prems => [ REPEAT (resolve_tac (exI::prems) 1) ]);
   1.341 +qed_goal "enabledI" Action.thy
   1.342 +  "|- A --> $Enabled A"
   1.343 +  (fn _ => [ auto_tac (claset(), simpset() addsimps [enabled_def]) ]);
   1.344  
   1.345  qed_goalw "enabledE" Action.thy [enabled_def]
   1.346 -  "[| (Enabled A) s; !!u. A[[s,u]] ==> PROP R |] ==> PROP R"
   1.347 +  "[| s |= Enabled A; !!u. A (s,u) ==> Q |] ==> Q"
   1.348    (fn prems => [cut_facts_tac prems 1,
   1.349 -                etac exE_prop 1,
   1.350 +                etac exE 1,
   1.351                  resolve_tac prems 1, atac 1
   1.352                 ]);
   1.353  
   1.354  qed_goal "notEnabledD" Action.thy
   1.355 -  "!!G. ~ (Enabled G s) ==> ~ G [[s,t]]"
   1.356 -  (fn _ => [ auto_tac (action_css addsimps2 [enabled_def]) ]);
   1.357 +  "|- ~$Enabled G --> ~ G"
   1.358 +  (fn _ => [ auto_tac (claset(), simpset() addsimps [enabled_def]) ]);
   1.359  
   1.360  (* Monotonicity *)
   1.361  qed_goal "enabled_mono" Action.thy
   1.362 -  "[| (Enabled F) s; F .-> G |] ==> (Enabled G) s"
   1.363 +  "[| s |= Enabled F; |- F --> G |] ==> s |= Enabled G"
   1.364    (fn [min,maj] => [rtac (min RS enabledE) 1,
   1.365 -                    rtac enabledI 1,
   1.366 -                    etac (action_mp maj) 1
   1.367 +                    rtac (action_use enabledI) 1,
   1.368 +                    etac (action_use maj) 1
   1.369                     ]);
   1.370  
   1.371  (* stronger variant *)
   1.372  qed_goal "enabled_mono2" Action.thy
   1.373 -   "[| (Enabled F) s; !!t. (F [[s,t]] ==> G[[s,t]] ) |] ==> (Enabled G) s"
   1.374 +   "[| s |= Enabled F; !!t. F (s,t) ==> G (s,t) |] ==> s |= Enabled G"
   1.375     (fn [min,maj] => [rtac (min RS enabledE) 1,
   1.376 -		     rtac enabledI 1,
   1.377 +		     rtac (action_use enabledI) 1,
   1.378  		     etac maj 1
   1.379  		    ]);
   1.380  
   1.381  qed_goal "enabled_disj1" Action.thy
   1.382 -  "!!s. (Enabled F) s ==> (Enabled (F .| G)) s"
   1.383 -  (fn _ => [etac enabled_mono 1, Auto_tac
   1.384 -	   ]);
   1.385 +  "|- Enabled F --> Enabled (F | G)"
   1.386 +  (fn _ => [ auto_tac (claset() addSEs [enabled_mono], simpset()) ]);
   1.387  
   1.388  qed_goal "enabled_disj2" Action.thy
   1.389 -  "!!s. (Enabled G) s ==> (Enabled (F .| G)) s"
   1.390 -  (fn _ => [etac enabled_mono 1, Auto_tac
   1.391 -	   ]);
   1.392 +  "|- Enabled G --> Enabled (F | G)"
   1.393 +  (fn _ => [ auto_tac (claset() addSEs [enabled_mono], simpset()) ]);
   1.394  
   1.395  qed_goal "enabled_conj1" Action.thy
   1.396 -  "!!s. (Enabled (F .& G)) s ==> (Enabled F) s"
   1.397 -  (fn _ => [etac enabled_mono 1, Auto_tac
   1.398 -           ]);
   1.399 +  "|- Enabled (F & G) --> Enabled F"
   1.400 +  (fn _ => [ auto_tac (claset() addSEs [enabled_mono], simpset()) ]);
   1.401  
   1.402  qed_goal "enabled_conj2" Action.thy
   1.403 -  "!!s. (Enabled (F .& G)) s ==> (Enabled G) s"
   1.404 -  (fn _ => [etac enabled_mono 1, Auto_tac
   1.405 -           ]);
   1.406 +  "|- Enabled (F & G) --> Enabled G"
   1.407 +  (fn _ => [ auto_tac (claset() addSEs [enabled_mono], simpset()) ]);
   1.408  
   1.409  qed_goal "enabled_conjE" Action.thy
   1.410 -  "[| (Enabled (F .& G)) s; [| (Enabled F) s; (Enabled G) s |] ==> PROP R |] ==> PROP R"
   1.411 +  "[| s |= Enabled (F & G); [| s |= Enabled F; s |= Enabled G |] ==> Q |] ==> Q"
   1.412    (fn prems => [cut_facts_tac prems 1, resolve_tac prems 1,
   1.413 -                etac enabled_conj1 1, etac enabled_conj2 1]);
   1.414 +                etac (action_use enabled_conj1) 1, 
   1.415 +		etac (action_use enabled_conj2) 1
   1.416 +	       ]);
   1.417  
   1.418  qed_goal "enabled_disjD" Action.thy
   1.419 -  "!!s. (Enabled (F .| G)) s ==> ((Enabled F) s) | ((Enabled G) s)"
   1.420 -  (fn _ => [etac enabledE 1,
   1.421 -            auto_tac (action_css addSDs2 [notEnabledD] addSEs2 [enabledI])
   1.422 -           ]);
   1.423 +  "|- Enabled (F | G) --> Enabled F | Enabled G"
   1.424 +  (fn _ => [ auto_tac (claset(), simpset() addsimps [enabled_def]) ]);
   1.425  
   1.426  qed_goal "enabled_disj" Action.thy
   1.427 -  "(Enabled (F .| G)) s = ( (Enabled F) s | (Enabled G) s )"
   1.428 -  (fn _ => [rtac iffI 1,
   1.429 -            etac enabled_disjD 1,
   1.430 -            REPEAT (eresolve_tac [disjE,enabled_disj1,enabled_disj2] 1)
   1.431 +  "|- Enabled (F | G) = (Enabled F | Enabled G)"
   1.432 +  (fn _ => [Clarsimp_tac 1,
   1.433 +	    rtac iffI 1,
   1.434 +            etac (action_use enabled_disjD) 1,
   1.435 +            REPEAT (eresolve_tac (disjE::map action_use [enabled_disj1,enabled_disj2]) 1)
   1.436             ]);
   1.437  
   1.438  qed_goal "enabled_ex" Action.thy
   1.439 -  "(Enabled (REX x. F x)) s = (EX x. (Enabled (F x)) s)"
   1.440 -  (fn _ => [ auto_tac (action_css addsimps2 [enabled_def]) ]);
   1.441 -	    
   1.442 +  "|- Enabled (? x. F x) = (? x. Enabled (F x))"
   1.443 +  (fn _ => [ force_tac (claset(), simpset() addsimps [enabled_def]) 1 ]);
   1.444 +
   1.445  
   1.446  (* A rule that combines enabledI and baseE, but generates fewer possible instantiations *)
   1.447  qed_goal "base_enabled" Action.thy
   1.448 -  "[| base_var(v); !!u. v u = c s ==> A [[s,u]] |] ==> Enabled A s"
   1.449 +  "[| basevars vs; !!u. vs u = c s ==> A (s,u) |] ==> s |= Enabled A"
   1.450    (fn prems => [cut_facts_tac prems 1,
   1.451 -		etac baseE 1, rtac enabledI 1,
   1.452 +		etac baseE 1, rtac (action_use enabledI) 1,
   1.453  		REPEAT (ares_tac prems 1)]);
   1.454  
   1.455  
   1.456 +(* ================================ action_simp_tac ================================== *)
   1.457 +
   1.458 +(* A dumb simplification-based tactic with just a little first-order logic:
   1.459 +   should plug in only "very safe" rules that can be applied blindly.
   1.460 +   Note that it applies whatever simplifications are currently active.
   1.461 +*)
   1.462 +fun action_simp_tac ss intros elims =
   1.463 +    asm_full_simp_tac 
   1.464 +         (ss setloop ((resolve_tac ((map action_use intros)
   1.465 +                                    @ [refl,impI,conjI,actionI,intI,allI]))
   1.466 +		      ORELSE' (eresolve_tac ((map action_use elims) 
   1.467 +                                             @ [conjE,disjE,exE]))));
   1.468 +
   1.469 +(* default version without additional plug-in rules *)
   1.470 +val Action_simp_tac = action_simp_tac (simpset()) [] [];
   1.471 +
   1.472 +
   1.473 +
   1.474  (* ---------------- enabled_tac: tactic to prove (Enabled A) -------------------- *)
   1.475  (* "Enabled A" can be proven as follows:
   1.476     - Assume that we know which state variables are "base variables";
   1.477 -     this should be expressed by a theorem of the form "base_var <x,y,z,...>".
   1.478 +     this should be expressed by a theorem of the form "basevars (x,y,z,...)".
   1.479     - Resolve this theorem with baseE to introduce a constant for the value of the
   1.480       variables in the successor state, and resolve the goal with the result.
   1.481 -   - E-resolve with PairVarE so that we have one constant per variable.
   1.482     - Resolve with enabledI and do some rewriting.
   1.483     - Solve for the unknowns using standard HOL reasoning.
   1.484     The following tactic combines these steps except the final one.
   1.485  *)
   1.486 -
   1.487 +(*** old version
   1.488  fun enabled_tac base_vars i =
   1.489      EVERY [(* apply actionI (plus rewriting) if the goal is of the form $(Enabled A),
   1.490 -	      do nothing if it is of the form (Enabled A) s *)
   1.491 -	   TRY ((rtac actionI i) THEN (SELECT_GOAL (rewrite_goals_tac action_rews) i)),
   1.492 -	   rtac (base_vars RS base_enabled) i,
   1.493 -	   REPEAT_DETERM (etac PairVarE i),
   1.494 +	      do nothing if it is of the form s |= Enabled A *)
   1.495 +	   TRY ((resolve_tac [actionI,intI] i) 
   1.496 +                THEN (SELECT_GOAL (rewrite_goals_tac action_rews) i)),
   1.497 +	   clarify_tac (claset() addSIs [base_vars RS base_enabled]) i,
   1.498  	   (SELECT_GOAL (rewrite_goals_tac action_rews) i)
   1.499  	  ];
   1.500 +***)
   1.501  
   1.502 -(* Example of use:
   1.503 +fun enabled_tac base_vars =
   1.504 +    clarsimp_tac (claset() addSIs [base_vars RS base_enabled], simpset());
   1.505  
   1.506 -val [prem] = goal Action.thy "base_var <x,y,z> ==> $x .-> $Enabled ($x .& (y$ .= #False))";
   1.507 -by (REPEAT ((CHANGED (Action_simp_tac 1)) ORELSE (enabled_tac prem 1)));
   1.508 +(* Example:
   1.509 +
   1.510 +val [prem] = goal thy "basevars (x,y,z) ==> |- x --> Enabled ($x & (y$ = #False))";
   1.511 +by (enabled_tac prem 1);
   1.512 +auto();
   1.513  
   1.514  *)
     2.1 --- a/src/HOL/TLA/Action.thy	Mon Feb 08 13:02:42 1999 +0100
     2.2 +++ b/src/HOL/TLA/Action.thy	Mon Feb 08 13:02:56 1999 +0100
     2.3 @@ -1,7 +1,7 @@
     2.4  (* 
     2.5      File:	 TLA/Action.thy
     2.6      Author:      Stephan Merz
     2.7 -    Copyright:   1997 University of Munich
     2.8 +    Copyright:   1998 University of Munich
     2.9  
    2.10      Theory Name: Action
    2.11      Logic Image: HOL
    2.12 @@ -11,50 +11,65 @@
    2.13  
    2.14  Action  =  Intensional + Stfun +
    2.15  
    2.16 +(** abstract syntax **)
    2.17 +
    2.18  types
    2.19 -    state2      (* intention: pair of states *)
    2.20 -    'a trfct = "('a, state2) term"
    2.21 -    action   = "state2 form"
    2.22 +  'a trfun = "(state * state) => 'a"
    2.23 +  action   = bool trfun
    2.24 +
    2.25 +instance
    2.26 +  "*" :: (world, world) world
    2.27  
    2.28 -arities
    2.29 -    state2 :: world
    2.30 -    
    2.31  consts
    2.32 -  mkstate2      :: "[state,state] => state2"  ("([[_,_]])")
    2.33 +  (** abstract syntax **)
    2.34 +  before        :: 'a stfun => 'a trfun
    2.35 +  after         :: 'a stfun => 'a trfun
    2.36 +  unch          :: 'a stfun => action
    2.37 +
    2.38 +  SqAct         :: [action, 'a stfun] => action
    2.39 +  AnAct         :: [action, 'a stfun] => action
    2.40 +  enabled       :: action => stpred
    2.41 +
    2.42 +(** concrete syntax **)
    2.43 +
    2.44 +syntax
    2.45 +  (* Syntax for writing action expressions in arbitrary contexts *)
    2.46 +  "ACT"         :: lift => 'a                      ("(ACT _)")
    2.47  
    2.48 -  (* lift state variables to transition functions *)
    2.49 -  before        :: "'a stfun => 'a trfct"            ("($_)"  [100] 99)
    2.50 -  after         :: "'a stfun => 'a trfct"            ("(_$)"  [100] 99)
    2.51 -  unchanged     :: "'a stfun => action"
    2.52 +  "_before"     :: lift => lift                    ("($_)"  [100] 99)
    2.53 +  "_after"      :: lift => lift                    ("(_$)"  [100] 99)
    2.54 +  "_unchanged"  :: lift => lift                    ("(unchanged _)" [100] 99)
    2.55 +
    2.56 +  (*** Priming: same as "after" ***)
    2.57 +  "_prime"      :: lift => lift                    ("(_`)" [100] 99)
    2.58 +
    2.59 +  "_SqAct"      :: [lift, lift] => lift            ("([_]'_(_))" [0,1000] 99)
    2.60 +  "_AnAct"      :: [lift, lift] => lift            ("(<_>'_(_))" [0,1000] 99)
    2.61 +  "_Enabled"    :: lift => lift                    ("(Enabled _)" [100] 100)
    2.62  
    2.63 -  (* Priming *)
    2.64 -  prime         :: "'a trfct => 'a trfct"            ("(_`)" [90] 89)
    2.65 -
    2.66 -  SqAct         :: "[action, 'a stfun] => action"    ("([_]'_(_))" [0,60] 59)
    2.67 -  AnAct         :: "[action, 'a stfun] => action"    ("(<_>'_(_))" [0,60] 59)
    2.68 -  Enabled       :: "action => stpred"
    2.69 +translations
    2.70 +  "ACT A"            =>   "(A::state*state => _)"
    2.71 +  "_before"          ==   "before"
    2.72 +  "_after"           =>   "_prime"
    2.73 +  "_unchanged"       ==   "unch"
    2.74 +  "_prime"           ==   "after"
    2.75 +  "_SqAct"           ==   "SqAct"
    2.76 +  "_AnAct"           ==   "AnAct"
    2.77 +  "_Enabled"         ==   "enabled"
    2.78 +  "w |= [A]_v"       <=   "_SqAct A v w"
    2.79 +  "w |= <A>_v"       <=   "_AnAct A v w"
    2.80 +  "s |= Enabled A"   <=   "_Enabled A s"
    2.81 +  "w |= unchanged f" <=   "_unchanged f w"
    2.82  
    2.83  rules
    2.84 -  (* The following says that state2 is generated by mkstate2 *)
    2.85 -  state2_ext    "(!!s t. [[s,t]] |= (A::action)) ==> (st::state2) |= A"
    2.86 -
    2.87 -  unl_before    "($v) [[s,t]] == v s"
    2.88 -  unl_after     "(v$) [[s,t]] == v t"
    2.89 +  unl_before    "(ACT $v) (s,t) == v s"
    2.90 +  unl_after     "(ACT v`) (s,t) == v t"
    2.91  
    2.92 -  pr_con        "(#c)` == #c"
    2.93 -  pr_before     "($v)` == v$"
    2.94 -  (* no corresponding rule for "after"! *)
    2.95 -  pr_lift       "(F[x])` == F[x`]"
    2.96 -  pr_lift2      "(F[x,y])` == F[x`,y`]"
    2.97 -  pr_lift3      "(F[x,y,z])` == F[x`,y`,z`]"
    2.98 -  pr_all        "(RALL x. P(x))` == (RALL x. P(x)`)"
    2.99 -  pr_ex         "(REX x. P(x))` == (REX x. P(x)`)"
   2.100 +  unchanged_def "(s,t) |= unchanged v == (v t = v s)"
   2.101 +  square_def    "ACT [A]_v == ACT (A | unchanged v)"
   2.102 +  angle_def     "ACT <A>_v == ACT (A & ~ unchanged v)"
   2.103  
   2.104 -  unchanged_def "(unchanged v) [[s,t]] == (v t = v s)"
   2.105 -  square_def    "[A]_v == A .| unchanged v"
   2.106 -  angle_def     "<A>_v == A .& .~ unchanged v"
   2.107 -
   2.108 -  enabled_def   "(Enabled A) s  ==  EX u. A[[s,u]]"
   2.109 +  enabled_def   "s |= Enabled A  ==  EX u. (s,u) |= A"
   2.110  end
   2.111  
   2.112  
     3.1 --- a/src/HOL/TLA/Buffer/Buffer.ML	Mon Feb 08 13:02:42 1999 +0100
     3.2 +++ b/src/HOL/TLA/Buffer/Buffer.ML	Mon Feb 08 13:02:56 1999 +0100
     3.3 @@ -8,31 +8,29 @@
     3.4  
     3.5  (* ---------------------------- Data lemmas ---------------------------- *)
     3.6  
     3.7 -(* "xs ~= [] --> tl(xs @ ys) = (tl xs) @ ys" *)
     3.8 -Addsimps [tl_append2];
     3.9 -
    3.10 +context List.thy;
    3.11  goal List.thy "xs ~= [] --> tl xs ~= xs";
    3.12  by (auto_tac (claset(), simpset() addsimps [neq_Nil_conv]));
    3.13  qed_spec_mp "tl_not_self";
    3.14 -Addsimps [tl_not_self];
    3.15 +context Buffer.thy;
    3.16  
    3.17 -(* "!ys zs. (ys @ xs = zs @ xs) = (ys=zs)" has been subsumed *)
    3.18 +Addsimps [tl_not_self];
    3.19  
    3.20  (* ---------------------------- Action lemmas ---------------------------- *)
    3.21  
    3.22  (* Dequeue is visible *)
    3.23 -Goal "<Deq ic q oc>_<ic,q,oc> .= Deq ic q oc";
    3.24 +Goal "|- <Deq ic q oc>_(ic,q,oc) = Deq ic q oc";
    3.25  by (auto_tac (claset(), simpset() addsimps [angle_def,Deq_def]));
    3.26  qed "Deq_visible";
    3.27  
    3.28  (* Enabling condition for dequeue -- NOT NEEDED *)
    3.29  Goalw [temp_rewrite Deq_visible]
    3.30 -   "!!q. base_var <ic,q,oc> ==> $Enabled (<Deq ic q oc>_<ic,q,oc>) .= ($q .~= .[])";
    3.31 +   "!!q. basevars (ic,q,oc) ==> |- Enabled (<Deq ic q oc>_(ic,q,oc)) = (q ~= #[])";
    3.32  by (force_tac (claset() addSEs [base_enabled,enabledE], simpset() addsimps [Deq_def]) 1);
    3.33  qed "Deq_enabled";
    3.34  
    3.35  (* For the left-to-right implication, we don't need the base variable stuff *)
    3.36  Goalw [temp_rewrite Deq_visible] 
    3.37 -   "$Enabled (<Deq ic q oc>_<ic,q,oc>) .-> ($q .~= .[])";
    3.38 +   "|- Enabled (<Deq ic q oc>_(ic,q,oc)) --> (q ~= #[])";
    3.39  by (auto_tac (claset() addSEs [enabledE], simpset() addsimps [Deq_def]));
    3.40  qed "Deq_enabledE";
     4.1 --- a/src/HOL/TLA/Buffer/Buffer.thy	Mon Feb 08 13:02:42 1999 +0100
     4.2 +++ b/src/HOL/TLA/Buffer/Buffer.thy	Mon Feb 08 13:02:56 1999 +0100
     4.3 @@ -9,16 +9,11 @@
     4.4     A simple FIFO buffer (synchronous communication, interleaving)
     4.5  *)
     4.6  
     4.7 -Buffer = TLA + List +
     4.8 +Buffer = TLA +
     4.9  
    4.10  consts
    4.11 -  (* infix syntax for list operations *)
    4.12 -  "IntNil"  :: 'w::world => 'a list                                       (".[]")
    4.13 -  "IntCons" :: ['w::world => 'a, 'w => 'a list] => ('w => 'a list)        ("(_ .#/ _)" [65,66] 65)
    4.14 -  "IntApp"  :: ['w::world => 'a list, 'w => 'a list] => ('w => 'a list)   ("(_ .@/ _)" [65,66] 65)
    4.15 -
    4.16    (* actions *)
    4.17 -  BInit     :: "'a stfun => 'a list stfun => 'a stfun => action"
    4.18 +  BInit     :: "'a stfun => 'a list stfun => 'a stfun => stpred"
    4.19    Enq       :: "'a stfun => 'a list stfun => 'a stfun => action"
    4.20    Deq       :: "'a stfun => 'a list stfun => 'a stfun => action"
    4.21    Next      :: "'a stfun => 'a list stfun => 'a stfun => action"
    4.22 @@ -27,30 +22,20 @@
    4.23    IBuffer   :: "'a stfun => 'a list stfun => 'a stfun => temporal"
    4.24    Buffer    :: "'a stfun => 'a stfun => temporal"
    4.25  
    4.26 -syntax
    4.27 -  "@listInt" :: args => ('a list, 'w) term      (".[(_)]")
    4.28 -
    4.29 -translations
    4.30 -  ".[]"          == "con []"
    4.31 -  "x .# xs"      == "lift2 (op #) x xs"
    4.32 -  "xs .@ ys"     == "lift2 (op @) xs ys"
    4.33 -  ".[ x, xs ]"   == "x .# .[xs]"
    4.34 -  ".[ x ]"       == "x .# .[]"
    4.35 -
    4.36  rules
    4.37 -  BInit_def   "BInit ic q oc    == $q .= .[]"
    4.38 -  Enq_def     "Enq ic q oc      ==    (ic$ .~= $ic) 
    4.39 -                                   .& (q$ .= $q .@ .[ ic$ ]) 
    4.40 -                                   .& (oc$ .= $oc)"
    4.41 -  Deq_def     "Deq ic q oc      ==    ($q .~= .[])
    4.42 -                                   .& (oc$ .= hd[ $q ])
    4.43 -                                   .& (q$ .= tl[ $q ])
    4.44 -                                   .& (ic$ .= $ic)"
    4.45 -  Next_def    "Next ic q oc     == Enq ic q oc .| Deq ic q oc"
    4.46 -  IBuffer_def "IBuffer ic q oc  ==    Init (BInit ic q oc)
    4.47 -                                   .& [][Next ic q oc]_<ic,q,oc>
    4.48 -                                   .& WF(Deq ic q oc)_<ic,q,oc>"
    4.49 -  Buffer_def  "Buffer ic oc     == EEX q. IBuffer ic q oc"
    4.50 +  BInit_def   "BInit ic q oc    == PRED q = #[]"
    4.51 +  Enq_def     "Enq ic q oc      == ACT (ic$ ~= $ic) 
    4.52 +                                     & (q$ = $q @ [ ic$ ]) 
    4.53 +                                     & (oc$ = $oc)"
    4.54 +  Deq_def     "Deq ic q oc      == ACT ($q ~= #[])
    4.55 +                                     & (oc$ = hd< $q >)
    4.56 +                                     & (q$ = tl< $q >)
    4.57 +                                     & (ic$ = $ic)"
    4.58 +  Next_def    "Next ic q oc     == ACT (Enq ic q oc | Deq ic q oc)"
    4.59 +  IBuffer_def "IBuffer ic q oc  == TEMP Init (BInit ic q oc)
    4.60 +                                      & [][Next ic q oc]_(ic,q,oc)
    4.61 +                                      & WF(Deq ic q oc)_(ic,q,oc)"
    4.62 +  Buffer_def  "Buffer ic oc     == TEMP (EEX q. IBuffer ic q oc)"
    4.63  end
    4.64  
    4.65  
     5.1 --- a/src/HOL/TLA/Buffer/DBuffer.ML	Mon Feb 08 13:02:42 1999 +0100
     5.2 +++ b/src/HOL/TLA/Buffer/DBuffer.ML	Mon Feb 08 13:02:56 1999 +0100
     5.3 @@ -6,6 +6,7 @@
     5.4      Double FIFO buffer implements simple FIFO buffer.
     5.5  *)
     5.6  
     5.7 +
     5.8  val db_css = (claset(), simpset() addsimps [qc_def]);
     5.9  Addsimps [qc_def];
    5.10  
    5.11 @@ -14,15 +15,15 @@
    5.12  
    5.13  
    5.14  (*** Proper initialization ***)
    5.15 -Goal "Init DBInit .-> Init (BInit inp qc out)";
    5.16 +Goal "|- Init DBInit --> Init (BInit inp qc out)";
    5.17  by (auto_tac (db_css addsimps2 [Init_def,DBInit_def,BInit_def]));
    5.18  qed "DBInit";
    5.19  
    5.20  
    5.21  (*** Step simulation ***)
    5.22 -Goal "[DBNext]_<inp,mid,out,q1,q2> .-> [Next inp qc out]_<inp,qc,out>";
    5.23 +Goal "|- [DBNext]_(inp,mid,out,q1,q2) --> [Next inp qc out]_(inp,qc,out)";
    5.24  by (rtac square_simulation 1);
    5.25 -by (Action_simp_tac 1);
    5.26 +by (Clarsimp_tac 1);
    5.27  by (action_simp_tac (simpset() addsimps hd_append::db_defs) [] [] 1);
    5.28  qed "DB_step_simulation";
    5.29  
    5.30 @@ -30,25 +31,23 @@
    5.31  (*** Simulation of fairness ***)
    5.32  
    5.33  (* Compute enabledness predicates for DBDeq and DBPass actions *)
    5.34 -Goal "<DBDeq>_<inp,mid,out,q1,q2> .= DBDeq";
    5.35 +Goal "|- <DBDeq>_(inp,mid,out,q1,q2) = DBDeq";
    5.36  by (auto_tac (db_css addsimps2 [angle_def,DBDeq_def,Deq_def]));
    5.37  qed "DBDeq_visible";
    5.38  
    5.39 -Goal "$Enabled (<DBDeq>_<inp,mid,out,q1,q2>) .= ($q2 .~= .[])";
    5.40 -by (rewtac (action_rewrite DBDeq_visible));
    5.41 -by (cut_facts_tac [DB_base] 1);
    5.42 -by (old_auto_tac (db_css addSEs2 [base_enabled,enabledE] 
    5.43 -                         addsimps2 [angle_def,DBDeq_def,Deq_def]));
    5.44 +Goalw [action_rewrite DBDeq_visible]
    5.45 +  "|- Enabled (<DBDeq>_(inp,mid,out,q1,q2)) = (q2 ~= #[])";
    5.46 +by (force_tac (db_css addSIs2 [DB_base RS base_enabled] addSEs2 [enabledE] 
    5.47 +                     addsimps2 [angle_def,DBDeq_def,Deq_def]) 1);
    5.48  qed "DBDeq_enabled";
    5.49  
    5.50 -Goal "<DBPass>_<inp,mid,out,q1,q2> .= DBPass";
    5.51 +Goal "|- <DBPass>_(inp,mid,out,q1,q2) = DBPass";
    5.52  by (auto_tac (db_css addsimps2 [angle_def,DBPass_def,Deq_def]));
    5.53  qed "DBPass_visible";
    5.54  
    5.55 -Goal "$Enabled (<DBPass>_<inp,mid,out,q1,q2>) .= ($q1 .~= .[])";
    5.56 -by (rewtac (action_rewrite DBPass_visible));
    5.57 -by (cut_facts_tac [DB_base] 1);
    5.58 -by (force_tac (db_css addSEs2 [base_enabled,enabledE] 
    5.59 +Goalw [action_rewrite DBPass_visible]
    5.60 +   "|- Enabled (<DBPass>_(inp,mid,out,q1,q2)) = (q1 ~= #[])";
    5.61 +by (force_tac (db_css addSIs2 [DB_base RS base_enabled] addSEs2 [enabledE] 
    5.62                       addsimps2 [angle_def,DBPass_def,Deq_def]) 1);
    5.63  qed "DBPass_enabled";
    5.64  
    5.65 @@ -58,8 +57,8 @@
    5.66     which is in turn reduced to the two leadsto conditions
    5.67     (1)  DBuffer => (Enabled (Deq inp qc out) ~> q2 ~= [])
    5.68     (2)  DBuffer => (q2 ~= [] ~> DBDeq)
    5.69 -   and the fact that DBDeq implies <Deq inp qc out>_<inp,qc,out>
    5.70 -   (and therefore DBDeq ~> <Deq inp qc out>_<inp,qc,out> trivially holds).
    5.71 +   and the fact that DBDeq implies <Deq inp qc out>_(inp,qc,out)
    5.72 +   (and therefore DBDeq ~> <Deq inp qc out>_(inp,qc,out) trivially holds).
    5.73  
    5.74     Condition (1) is reduced to
    5.75     (1a) DBuffer => (qc ~= [] /\ q2 = [] ~> q2 ~= [])
    5.76 @@ -73,47 +72,47 @@
    5.77  *)
    5.78  
    5.79  (* Condition (1a) *)
    5.80 -Goal 
    5.81 -  "[][DBNext]_<inp,mid,out,q1,q2> .& WF(DBPass)_<inp,mid,out,q1,q2> \
    5.82 -\  .-> ($qc .~= .[] .& $q2 .= .[] ~> $q2 .~= .[])";
    5.83 +Goal "|- [][DBNext]_(inp,mid,out,q1,q2) & WF(DBPass)_(inp,mid,out,q1,q2) \
    5.84 +\        --> (qc ~= #[] & q2 = #[] ~> q2 ~= #[])";
    5.85  by (rtac WF1 1);
    5.86 -by (action_simp_tac (simpset() addsimps square_def::db_defs) [] [] 1);
    5.87 -by (action_simp_tac (simpset() addsimps [angle_def,DBPass_def]) [] [] 1);
    5.88 -by (action_simp_tac (simpset() addsimps [DBPass_enabled]) [] [] 1);
    5.89 +by (force_tac (db_css addsimps2 db_defs) 1);
    5.90 +by (force_tac (db_css addsimps2 [angle_def,DBPass_def]) 1);
    5.91 +by (force_tac (db_css addsimps2 [DBPass_enabled]) 1);
    5.92  qed "DBFair_1a";
    5.93  
    5.94  (* Condition (1) *)
    5.95 -Goal
    5.96 -  "[][DBNext]_<inp,mid,out,q1,q2> .& WF(DBPass)_<inp,mid,out,q1,q2> \
    5.97 -\  .-> ($Enabled (<Deq inp qc out>_<inp,qc,out>) ~> $q2 .~= .[])";
    5.98 -by (auto_tac (temp_css addSIs2 [leadsto_classical] addSEs2 [temp_conjimpE DBFair_1a]));
    5.99 -by (force_tac (temp_css addsimps2 [leadsto,Init_def] addDs2 [STL2bD]
   5.100 -                        addSDs2 [action_mp Deq_enabledE] addSEs2 [STL4E]) 1);
   5.101 +Goal "|- [][DBNext]_(inp,mid,out,q1,q2) & WF(DBPass)_(inp,mid,out,q1,q2) \
   5.102 +\        --> (Enabled (<Deq inp qc out>_(inp,qc,out)) ~> q2 ~= #[])";
   5.103 +by (Clarsimp_tac 1);
   5.104 +by (rtac (temp_use leadsto_classical) 1);
   5.105 +by (rtac ((temp_use DBFair_1a) RS (temp_use LatticeTransitivity)) 1);
   5.106 +by (TRYALL atac);
   5.107 +by (rtac (temp_use ImplLeadsto_gen) 1);
   5.108 +by (force_tac (db_css addSIs2 [necT] addSDs2 [STL2_gen, Deq_enabledE]
   5.109 +                      addsimps2 Init_defs) 1);
   5.110  qed "DBFair_1";
   5.111  
   5.112  (* Condition (2) *)
   5.113 -Goal
   5.114 -  "[][DBNext]_<inp,mid,out,q1,q2> .& WF(DBDeq)_<inp,mid,out,q1,q2> \
   5.115 -\  .-> ($q2 .~= .[] ~> DBDeq)";
   5.116 +Goal "|- [][DBNext]_(inp,mid,out,q1,q2) & WF(DBDeq)_(inp,mid,out,q1,q2) \
   5.117 +\        --> (q2 ~= #[] ~> DBDeq)";
   5.118  by (rtac WF_leadsto 1);
   5.119 -by (action_simp_tac (simpset() addsimps [DBDeq_visible,DBDeq_enabled]) [] [] 1);
   5.120 -by (action_simp_tac (simpset() addsimps [angle_def]) [] [] 1);
   5.121 -by (action_simp_tac (simpset() addsimps square_def::db_defs) [tempI] [Stable] 1);
   5.122 +by (force_tac (db_css addsimps2 [DBDeq_enabled]) 1);
   5.123 +by (force_tac (db_css addsimps2 [angle_def]) 1);
   5.124 +by (force_tac (db_css addsimps2 db_defs addSEs2 [Stable]) 1);
   5.125  qed "DBFair_2";
   5.126  
   5.127  (* High-level fairness *)
   5.128 -Goal
   5.129 -  "[][DBNext]_<inp,mid,out,q1,q2> .& WF(DBPass)_<inp,mid,out,q1,q2> \
   5.130 -\                                 .& WF(DBDeq)_<inp,mid,out,q1,q2>  \ 
   5.131 -\  .-> WF(Deq inp qc out)_<inp,qc,out>";
   5.132 -by (auto_tac (db_css addSIs2 [leadsto_WF]));
   5.133 -by (auto_tac (db_css addSIs2 [(temp_mp DBFair_1) RSN(2,LatticeTransitivity)]));
   5.134 -by (auto_tac (db_css addSIs2 [(temp_mp DBFair_2) RSN(2,LatticeTransitivity)]));
   5.135 -by (auto_tac (db_css addSIs2 [ImplLeadsto] addSEs2 [STL4E]
   5.136 +Goal "|- [][DBNext]_(inp,mid,out,q1,q2) & WF(DBPass)_(inp,mid,out,q1,q2) \
   5.137 +\                                       & WF(DBDeq)_(inp,mid,out,q1,q2)  \ 
   5.138 +\        --> WF(Deq inp qc out)_(inp,qc,out)";
   5.139 +by (auto_tac (temp_css addSIs2 [leadsto_WF,
   5.140 +                                (temp_use DBFair_1) RSN(2,(temp_use LatticeTransitivity)),
   5.141 +                                (temp_use DBFair_2) RSN(2,(temp_use LatticeTransitivity))]));
   5.142 +by (auto_tac (db_css addSIs2 [ImplLeadsto_simple]
   5.143                       addsimps2 [angle_def,DBDeq_def,Deq_def,hd_append]));
   5.144  qed "DBFair";
   5.145  
   5.146  (*** Main theorem ***)
   5.147 -Goalw [DBuffer_def,Buffer_def,IBuffer_def] "DBuffer .-> Buffer inp out";
   5.148 -by (ALLGOALS (force_tac (db_css addSIs2 (map temp_mp [eexI,DBInit,DB_step_simulation RS STL4,DBFair]))));
   5.149 +Goalw [DBuffer_def,Buffer_def,IBuffer_def] "|- DBuffer --> Buffer inp out";
   5.150 +by (force_tac (temp_css addSIs2 [eexI,DBInit,DB_step_simulation RS STL4,DBFair]) 1);
   5.151  qed "DBuffer_impl_Buffer";
     6.1 --- a/src/HOL/TLA/Buffer/DBuffer.thy	Mon Feb 08 13:02:42 1999 +0100
     6.2 +++ b/src/HOL/TLA/Buffer/DBuffer.thy	Mon Feb 08 13:02:56 1999 +0100
     6.3 @@ -16,25 +16,26 @@
     6.4    inp, mid, out  :: nat stfun
     6.5    q1, q2, qc     :: nat list stfun
     6.6  
     6.7 -  DBInit, DBEnq, DBDeq, DBPass, DBNext   :: action
     6.8 -  DBuffer                                :: temporal
     6.9 +  DBInit                         :: stpred
    6.10 +  DBEnq, DBDeq, DBPass, DBNext   :: action
    6.11 +  DBuffer                        :: temporal
    6.12  
    6.13  rules
    6.14 -  DB_base        "base_var <inp,mid,out,q1,q2>"
    6.15 +  DB_base        "basevars (inp,mid,out,q1,q2)"
    6.16  
    6.17    (* the concatenation of the two buffers *)
    6.18 -  qc_def         "$qc .= $q2 .@ $q1"
    6.19 +  qc_def         "PRED qc == PRED (q2 @ q1)"
    6.20  
    6.21 -  DBInit_def     "DBInit   == BInit inp q1 mid  .&  BInit mid q2 out"
    6.22 -  DBEnq_def      "DBEnq    == Enq inp q1 mid  .&  unchanged <q2,out>"
    6.23 -  DBDeq_def      "DBDeq    == Deq mid q2 out .&  unchanged <inp,q1>"
    6.24 -  DBPass_def     "DBPass   ==    Deq inp q1 mid
    6.25 -                              .& (q2$ .= $q2 .@ .[ mid$ ])
    6.26 -                              .& (out$ .= $out)"
    6.27 -  DBNext_def     "DBNext   == DBEnq .| DBDeq .| DBPass"
    6.28 -  DBuffer_def    "DBuffer  ==    Init(DBInit)
    6.29 -                              .& [][DBNext]_<inp,mid,out,q1,q2>
    6.30 -                              .& WF(DBDeq)_<inp,mid,out,q1,q2>
    6.31 -                              .& WF(DBPass)_<inp,mid,out,q1,q2>"
    6.32 +  DBInit_def     "DBInit   == PRED (BInit inp q1 mid  &  BInit mid q2 out)"
    6.33 +  DBEnq_def      "DBEnq    == ACT  Enq inp q1 mid  &  unchanged (q2,out)"
    6.34 +  DBDeq_def      "DBDeq    == ACT  Deq mid q2 out  &  unchanged (inp,q1)"
    6.35 +  DBPass_def     "DBPass   == ACT  Deq inp q1 mid
    6.36 +                                 & (q2$ = $q2 @ [ mid$ ])
    6.37 +                                 & (out$ = $out)"
    6.38 +  DBNext_def     "DBNext   == ACT  (DBEnq | DBDeq | DBPass)"
    6.39 +  DBuffer_def    "DBuffer  == TEMP Init DBInit
    6.40 +                                 & [][DBNext]_(inp,mid,out,q1,q2)
    6.41 +                                 & WF(DBDeq)_(inp,mid,out,q1,q2)
    6.42 +                                 & WF(DBPass)_(inp,mid,out,q1,q2)"
    6.43  
    6.44  end
    6.45 \ No newline at end of file
     7.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.2 +++ b/src/HOL/TLA/Buffer/index.html	Mon Feb 08 13:02:56 1999 +0100
     7.3 @@ -0,0 +1,8 @@
     7.4 +<HTML><HEAD><TITLE>buffer</TITLE></HEAD>
     7.5 +<BODY><H2>buffer</H2>
     7.6 +The name of every theory is linked to its theory file<BR>
     7.7 +<IMG SRC = "../../../Tools/red_arrow.gif" ALT = \/></A> stands for subtheories (child theories)<BR>
     7.8 +<IMG SRC = "../../../Tools/blue_arrow.gif" ALT = /\></A> stands for supertheories (parent theories)<P>
     7.9 +<A HREF = "../../index.html">Back</A> to the index of ex
    7.10 +<HR><A HREF = ".Buffer_sub.html"><IMG SRC = "../../../Tools/red_arrow.gif" BORDER=0 ALT = \/></A><A HREF = ".Buffer_sup.html"><IMG SRC = "../../../Tools/blue_arrow.gif" BORDER=0 ALT = /\></A> <A HREF = ".Buffer.html">Buffer</A><BR>
    7.11 +<A HREF = ".DBuffer_sub.html"><IMG SRC = "../../../Tools/red_arrow.gif" BORDER=0 ALT = \/></A><A HREF = ".DBuffer_sup.html"><IMG SRC = "../../../Tools/blue_arrow.gif" BORDER=0 ALT = /\></A> <A HREF = ".DBuffer.html">DBuffer</A><BR>
     8.1 --- a/src/HOL/TLA/Inc/Inc.ML	Mon Feb 08 13:02:42 1999 +0100
     8.2 +++ b/src/HOL/TLA/Inc/Inc.ML	Mon Feb 08 13:02:56 1999 +0100
     8.3 @@ -14,65 +14,61 @@
     8.4  
     8.5  (*** Invariant proof for Psi: "manual" proof proves individual lemmas ***)
     8.6  
     8.7 -qed_goal "PsiInv_Init" Inc.thy "InitPsi .-> PsiInv"
     8.8 +qed_goal "PsiInv_Init" Inc.thy "|- InitPsi --> PsiInv"
     8.9   (fn _ => [ auto_tac (Inc_css addsimps2 InitPsi_def::PsiInv_defs) ]);
    8.10  
    8.11 -qed_goal "PsiInv_alpha1" Inc.thy "alpha1 .& PsiInv .-> PsiInv`"
    8.12 +qed_goal "PsiInv_alpha1" Inc.thy "|- alpha1 & $PsiInv --> PsiInv`"
    8.13    (fn _ => [ auto_tac (Inc_css addsimps2 alpha1_def::PsiInv_defs) ]);
    8.14  
    8.15 -qed_goal "PsiInv_alpha2" Inc.thy "alpha2 .& PsiInv .-> PsiInv`"
    8.16 +qed_goal "PsiInv_alpha2" Inc.thy "|- alpha2 & $PsiInv --> PsiInv`"
    8.17    (fn _ => [ auto_tac (Inc_css addsimps2 alpha2_def::PsiInv_defs) ]);
    8.18  
    8.19 -qed_goal "PsiInv_beta1" Inc.thy "beta1 .& PsiInv .-> PsiInv`"
    8.20 +qed_goal "PsiInv_beta1" Inc.thy "|- beta1 & $PsiInv --> PsiInv`"
    8.21    (fn _ => [ auto_tac (Inc_css addsimps2 beta1_def::PsiInv_defs) ]);
    8.22  
    8.23 -qed_goal "PsiInv_beta2" Inc.thy "beta2 .& PsiInv .-> PsiInv`"
    8.24 +qed_goal "PsiInv_beta2" Inc.thy "|- beta2 & $PsiInv --> PsiInv`"
    8.25    (fn _ => [ auto_tac (Inc_css addsimps2 beta2_def::PsiInv_defs) ]);
    8.26  
    8.27 -qed_goal "PsiInv_gamma1" Inc.thy "gamma1 .& PsiInv .-> PsiInv`"
    8.28 +qed_goal "PsiInv_gamma1" Inc.thy "|- gamma1 & $PsiInv --> PsiInv`"
    8.29    (fn _ => [ auto_tac (Inc_css addsimps2 gamma1_def::PsiInv_defs) ]);
    8.30  
    8.31 -qed_goal "PsiInv_gamma2" Inc.thy "gamma2 .& PsiInv .-> PsiInv`"
    8.32 +qed_goal "PsiInv_gamma2" Inc.thy "|- gamma2 & $PsiInv --> PsiInv`"
    8.33    (fn _ => [ auto_tac (Inc_css addsimps2 gamma2_def::PsiInv_defs) ]);
    8.34  
    8.35 -qed_goal "PsiInv_stutter" Inc.thy "unchanged <x,y,sem,pc1,pc2> .& PsiInv .-> PsiInv`"
    8.36 +qed_goal "PsiInv_stutter" Inc.thy "|- unchanged (x,y,sem,pc1,pc2) & $PsiInv --> PsiInv`"
    8.37    (fn _ => [ auto_tac (Inc_css addsimps2 PsiInv_defs) ]);
    8.38  
    8.39 -qed_goal "PsiInv" Inc.thy "Psi .-> []PsiInv" (K [
    8.40 +qed_goal "PsiInv" Inc.thy "|- Psi --> []PsiInv" (K [
    8.41  	    inv_tac (Inc_css addsimps2 [Psi_def]) 1,
    8.42 -	    SELECT_GOAL (auto_tac (Inc_css addSIs2 [action_mp PsiInv_Init]
    8.43 -				           addsimps2 [Init_def])) 1,
    8.44 -	    force_tac (Inc_css addSEs2 (map action_conjimpE
    8.45 -				   [PsiInv_alpha1,PsiInv_alpha2,PsiInv_beta1,
    8.46 -				    PsiInv_beta2,PsiInv_gamma1,PsiInv_gamma2])
    8.47 -		               addIs2 [action_mp PsiInv_stutter]
    8.48 -                               addsimps2 [square_def,N1_def, N2_def]) 1]);
    8.49 -
    8.50 -
    8.51 +	    force_tac (Inc_css addsimps2 [PsiInv_Init, Init_def]) 1,
    8.52 +	    auto_tac (Inc_css addIs2
    8.53 +		        [PsiInv_alpha1,PsiInv_alpha2,PsiInv_beta1,
    8.54 +			 PsiInv_beta2,PsiInv_gamma1,PsiInv_gamma2,PsiInv_stutter]
    8.55 +                        addsimps2 [square_def,N1_def, N2_def]) ]);
    8.56  
    8.57  (* Automatic proof works too, but it make take a while on a slow machine.
    8.58 -   More substantial examples require manual guidance anyway.
    8.59 +   More realistic examples require user guidance anyway.
    8.60  
    8.61 -Goal "Psi .-> []PsiInv";
    8.62 -by (auto_inv_tac (simpset() addsimps PsiInv_defs @ Psi_defs @ pcount.simps) 1);
    8.63 +Goal "|- Psi --> []PsiInv";
    8.64 +by (auto_inv_tac (simpset() addsimps PsiInv_defs @ Psi_defs) 1);
    8.65  
    8.66  *)
    8.67  
    8.68  (**** Step simulation ****)
    8.69  
    8.70 -qed_goal "Init_sim" Inc.thy "Psi .-> Init(InitPhi)"
    8.71 +qed_goal "Init_sim" Inc.thy "|- Psi --> Init InitPhi"
    8.72    (fn _ => [ auto_tac (Inc_css addsimps2 [InitPhi_def,Psi_def,InitPsi_def,Init_def]) ]);
    8.73  
    8.74 -qed_goal "Step_sim" Inc.thy "Psi .-> [][M1 .| M2]_<x,y>"
    8.75 +qed_goal "Step_sim" Inc.thy "|- Psi --> [][M1 | M2]_(x,y)"
    8.76    (fn _ => [auto_tac (Inc_css addsimps2 [square_def,M1_def,M2_def] @ Psi_defs
    8.77 -                              addSEs2 [STL4E]) 
    8.78 +                              addSEs2 [STL4E])
    8.79             ]);
    8.80  
    8.81  (**** Proof of fairness ****)
    8.82  
    8.83  (*
    8.84     The goal is to prove Fair_M1 far below, which asserts 
    8.85 -         Psi .-> WF(M1)_<x,y>   
    8.86 +         |- Psi --> WF(M1)_(x,y)
    8.87     (the other fairness condition is symmetrical).
    8.88  
    8.89     The strategy is to use WF2 (with beta1 as the helpful action). Proving its
    8.90 @@ -87,97 +83,94 @@
    8.91  *)
    8.92  
    8.93  qed_goal "Stuck_at_b" Inc.thy
    8.94 -  "[][(N1 .| N2) .& .~ beta1]_<x,y,sem,pc1,pc2> .-> stable($pc1 .= #b)"
    8.95 -  (fn _ => [rtac StableL 1,
    8.96 -	    auto_tac (Inc_css addsimps2 square_def::Psi_defs)
    8.97 -	   ]);
    8.98 +  "|- [][(N1 | N2) & ~ beta1]_(x,y,sem,pc1,pc2) --> stable(pc1 = #b)"
    8.99 +  (fn _ => [ auto_tac (Inc_css addSEs2 [Stable,squareE] addsimps2 Psi_defs) ]);
   8.100  
   8.101  qed_goal "N1_enabled_at_g" Inc.thy
   8.102 -  "($pc1 .= #g) .-> $(Enabled (<N1>_<x,y,sem,pc1,pc2>))"
   8.103 -  (fn _ => [Action_simp_tac 1,
   8.104 +  "|- pc1 = #g --> Enabled (<N1>_(x,y,sem,pc1,pc2))"
   8.105 +  (fn _ => [Clarsimp_tac 1,
   8.106  	    res_inst_tac [("F","gamma1")] enabled_mono 1,
   8.107  	    enabled_tac Inc_base 1,
   8.108  	    auto_tac (Inc_css addsimps2 [angle_def,gamma1_def,N1_def])
   8.109  	   ]);
   8.110  
   8.111  qed_goal "g1_leadsto_a1" Inc.thy
   8.112 -  "[][(N1 .| N2) .& .~ beta1]_<x,y,sem,pc1,pc2> .& SF(N1)_<x,y,sem,pc1,pc2> .& []#True \
   8.113 -\  .-> ($pc1 .= #g ~> $pc1 .= #a)"
   8.114 +  "|- [][(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2) & SF(N1)_(x,y,sem,pc1,pc2) & []#True \
   8.115 +\     --> (pc1 = #g ~> pc1 = #a)"
   8.116    (fn _ => [rtac SF1 1,
   8.117 -	    (* the first two subgoals are simple action formulas and succumb to the
   8.118 -	       auto_tac; don't expand N1 in the third subgoal *)
   8.119 -	    SELECT_GOAL (auto_tac (Inc_css addsimps2 [square_def] @ Psi_defs)) 1,
   8.120 -	    SELECT_GOAL (auto_tac (Inc_css addsimps2 [angle_def] @ Psi_defs)) 1,
   8.121 -	    (* reduce []A .-> <>Enabled B  to  A .-> Enabled B *)
   8.122 -	    auto_tac (Inc_css addSIs2 [InitDmdD, action_mp N1_enabled_at_g]
   8.123 -		              addSDs2 [STL2bD]
   8.124 +	    action_simp_tac (simpset() addsimps Psi_defs) [] [squareE] 1,
   8.125 +	    action_simp_tac (simpset() addsimps angle_def::Psi_defs) [] [] 1,
   8.126 +	    (* reduce |- []A --> <>Enabled B  to  |- A --> Enabled B *)
   8.127 +	    auto_tac (Inc_css addSIs2 [InitDmd_gen, N1_enabled_at_g]
   8.128 +		              addSDs2 [STL2_gen]
   8.129  		              addsimps2 [Init_def])
   8.130  	   ]);
   8.131  
   8.132  (* symmetrical for N2, and similar for beta2 *)
   8.133  qed_goal "N2_enabled_at_g" Inc.thy
   8.134 -  "($pc2 .= #g) .-> $(Enabled (<N2>_<x,y,sem,pc1,pc2>))"
   8.135 -  (fn _ => [Action_simp_tac 1,
   8.136 +  "|- pc2 = #g --> Enabled (<N2>_(x,y,sem,pc1,pc2))"
   8.137 +  (fn _ => [Clarsimp_tac 1,
   8.138  	    res_inst_tac [("F","gamma2")] enabled_mono 1,
   8.139  	    enabled_tac Inc_base 1,
   8.140  	    auto_tac (Inc_css addsimps2 [angle_def,gamma2_def,N2_def])
   8.141  	   ]);
   8.142  
   8.143  qed_goal "g2_leadsto_a2" Inc.thy
   8.144 -  "[][(N1 .| N2) .& .~ beta1]_<x,y,sem,pc1,pc2> .& SF(N2)_<x,y,sem,pc1,pc2> .& []#True \
   8.145 -\  .-> ($pc2 .= #g ~> $pc2 .= #a)"
   8.146 +  "|- [][(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2) & SF(N2)_(x,y,sem,pc1,pc2) & []#True \
   8.147 +\     --> (pc2 = #g ~> pc2 = #a)"
   8.148    (fn _ => [rtac SF1 1,
   8.149 -	    SELECT_GOAL (auto_tac (Inc_css addsimps2 [square_def] @ Psi_defs)) 1,
   8.150 -	    SELECT_GOAL (auto_tac (Inc_css addsimps2 [angle_def] @ Psi_defs)) 1,
   8.151 -	    auto_tac (Inc_css addSIs2 [InitDmdD, action_mp N2_enabled_at_g]
   8.152 -		              addSDs2 [STL2bD]
   8.153 +	    action_simp_tac (simpset() addsimps Psi_defs) [] [squareE] 1,
   8.154 +	    action_simp_tac (simpset() addsimps angle_def::Psi_defs) [] [] 1,
   8.155 +	    auto_tac (Inc_css addSIs2 [InitDmd_gen, N2_enabled_at_g]
   8.156 +		              addSDs2 [STL2_gen]
   8.157  		              addsimps2 [Init_def])
   8.158  	   ]);
   8.159  
   8.160  qed_goal "N2_enabled_at_b" Inc.thy
   8.161 -  "($pc2 .= #b) .-> $(Enabled (<N2>_<x,y,sem,pc1,pc2>))"
   8.162 -  (fn _ => [Action_simp_tac 1,
   8.163 +  "|- pc2 = #b --> Enabled (<N2>_(x,y,sem,pc1,pc2))"
   8.164 +  (fn _ => [Clarsimp_tac 1,
   8.165  	    res_inst_tac [("F","beta2")] enabled_mono 1,
   8.166  	    enabled_tac Inc_base 1,
   8.167  	    auto_tac (Inc_css addsimps2 [angle_def,beta2_def,N2_def])
   8.168  	   ]);
   8.169  
   8.170  qed_goal "b2_leadsto_g2" Inc.thy
   8.171 -  "[][(N1 .| N2) .& .~ beta1]_<x,y,sem,pc1,pc2> .& SF(N2)_<x,y,sem,pc1,pc2> .& []#True \
   8.172 -\  .-> ($pc2 .= #b ~> $pc2 .= #g)"
   8.173 +  "|- [][(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2) & SF(N2)_(x,y,sem,pc1,pc2) & []#True \
   8.174 +\     --> (pc2 = #b ~> pc2 = #g)"
   8.175    (fn _ => [rtac SF1 1,
   8.176 -	    SELECT_GOAL (auto_tac (Inc_css addsimps2 [square_def] @ Psi_defs)) 1,
   8.177 -	    SELECT_GOAL (auto_tac (Inc_css addsimps2 [angle_def] @ Psi_defs)) 1,
   8.178 -	    auto_tac (Inc_css addSIs2 [InitDmdD, action_mp N2_enabled_at_b]
   8.179 -		              addSDs2 [STL2bD]
   8.180 +	    action_simp_tac (simpset() addsimps Psi_defs) [] [squareE] 1,
   8.181 +	    action_simp_tac (simpset() addsimps angle_def::Psi_defs) [] [] 1,
   8.182 +	    auto_tac (Inc_css addSIs2 [InitDmd_gen, N2_enabled_at_b]
   8.183 +		              addSDs2 [STL2_gen]
   8.184  		              addsimps2 [Init_def])
   8.185  	   ]);
   8.186  
   8.187  (* Combine above lemmas: the second component will eventually reach pc2 = a *)
   8.188  qed_goal "N2_leadsto_a" Inc.thy
   8.189 -  "[][(N1 .| N2) .& .~ beta1]_<x,y,sem,pc1,pc2> .& SF(N2)_<x,y,sem,pc1,pc2> .& []#True \
   8.190 -\  .-> (($pc2 .= #a .| $pc2 .= #b .| $pc2 .= #g) ~> $pc2 .= #a)"
   8.191 +  "|- [][(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2) & SF(N2)_(x,y,sem,pc1,pc2) & []#True \
   8.192 +\     --> (pc2 = #a | pc2 = #b | pc2 = #g ~> pc2 = #a)"
   8.193    (fn _ => [auto_tac (Inc_css addSIs2 [LatticeDisjunctionIntro]),
   8.194 -	    rtac (LatticeReflexivity RS tempD) 1,
   8.195 -	    rtac LatticeTransitivity 1,
   8.196 -	    auto_tac (Inc_css addSIs2 (map temp_mp [b2_leadsto_g2,g2_leadsto_a2]))
   8.197 +	    rtac (temp_use LatticeReflexivity) 1,
   8.198 +	    rtac (temp_use LatticeTransitivity) 1,
   8.199 +	    auto_tac (Inc_css addSIs2 [b2_leadsto_g2,g2_leadsto_a2])
   8.200  	   ]);
   8.201  
   8.202 -(* A variant that gets rid of the disjunction, thanks to induction over data types *)
   8.203 +(* Get rid of complete disjunction on the left-hand side of ~> above. *)
   8.204  qed_goal "N2_live" Inc.thy
   8.205 -  "[][(N1 .| N2) .& .~ beta1]_<x,y,sem,pc1,pc2> .& SF(N2)_<x,y,sem,pc1,pc2> \
   8.206 -\  .-> <>($pc2 .= #a)"
   8.207 -  (fn _ => [auto_tac (Inc_css addSIs2 [(temp_mp N2_leadsto_a) RSN(2,leadsto_init)]),
   8.208 -	    rewrite_goals_tac (Init_def::action_rews),
   8.209 -	    exhaust_tac "pc2 (fst_st sigma)" 1,
   8.210 +  "|- [][(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2) & SF(N2)_(x,y,sem,pc1,pc2) \
   8.211 +\     --> <>(pc2 = #a)"
   8.212 +  (fn _ => [auto_tac (Inc_css addsimps2 Init_defs
   8.213 +                              addSIs2 [(temp_use N2_leadsto_a) 
   8.214 +                                       RSN(2, (temp_use leadsto_init))]),
   8.215 +	    exhaust_tac "pc2 (st1 sigma)" 1,
   8.216  	    Auto_tac
   8.217  	   ]);
   8.218  
   8.219  (* Now prove that the first component will eventually reach pc1 = b from pc1 = a *)
   8.220  
   8.221  qed_goal "N1_enabled_at_both_a" Inc.thy
   8.222 -  "$pc2 .= #a .& (PsiInv .& $pc1 .= #a) .-> $(Enabled (<N1>_<x,y,sem,pc1,pc2>))"
   8.223 -  (fn _ => [Action_simp_tac 1,
   8.224 +  "|- pc2 = #a & (PsiInv & pc1 = #a) --> Enabled (<N1>_(x,y,sem,pc1,pc2))"
   8.225 +  (fn _ => [Clarsimp_tac 1,
   8.226  	    res_inst_tac [("F","alpha1")] enabled_mono 1,
   8.227  	    enabled_tac Inc_base 1,
   8.228  	    auto_tac (Inc_css addIs2 [sym]
   8.229 @@ -185,43 +178,44 @@
   8.230  	   ]);
   8.231  
   8.232  qed_goal "a1_leadsto_b1" Inc.thy
   8.233 -  "[](PsiInv .& [(N1 .| N2) .& .~ beta1]_<x,y,sem,pc1,pc2>)              \
   8.234 -\            .& SF(N1)_<x,y,sem,pc1,pc2> .& [] SF(N2)_<x,y,sem,pc1,pc2>  \
   8.235 -\  .-> ($pc1 .= #a ~> $pc1 .= #b)"
   8.236 +  "|- []($PsiInv & [(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2))            \
   8.237 +\           & SF(N1)_(x,y,sem,pc1,pc2) & [] SF(N2)_(x,y,sem,pc1,pc2)  \
   8.238 +\     --> (pc1 = #a ~> pc1 = #b)"
   8.239    (fn _ => [rtac SF1 1,
   8.240 -	    SELECT_GOAL (auto_tac (Inc_css addsimps2 [square_def] @ Psi_defs)) 1,
   8.241 -	    SELECT_GOAL (auto_tac (Inc_css addsimps2 [angle_def] @ Psi_defs)) 1,
   8.242 -	    auto_tac (Inc_css addSIs2 [N1_enabled_at_both_a RS (temp_mp DmdImpl)]),
   8.243 -	    auto_tac (Inc_css addSIs2 [temp_mp BoxDmdT2, temp_mp N2_live]
   8.244 +            action_simp_tac (simpset() addsimps Psi_defs) [] [squareE] 1,
   8.245 +            action_simp_tac (simpset() addsimps angle_def::Psi_defs) [] [] 1,
   8.246 +	    clarsimp_tac (Inc_css addSIs2 [N1_enabled_at_both_a RS (temp_use DmdImpl)]) 1,
   8.247 +	    auto_tac (Inc_css addSIs2 [BoxDmd2_simple, N2_live]
   8.248  		              addsimps2 split_box_conj::more_temp_simps)
   8.249  	   ]);
   8.250  
   8.251  (* Combine the leadsto properties for N1: it will arrive at pc1 = b *)
   8.252  
   8.253  qed_goal "N1_leadsto_b" Inc.thy
   8.254 -  "[](PsiInv .& [(N1 .| N2) .& .~ beta1]_<x,y,sem,pc1,pc2>)              \
   8.255 -\            .& SF(N1)_<x,y,sem,pc1,pc2> .& [] SF(N2)_<x,y,sem,pc1,pc2>  \
   8.256 -\  .-> (($pc1 .= #b .| $pc1 .= #g .| $pc1 .= #a) ~> $pc1 .= #b)"
   8.257 +  "|- []($PsiInv & [(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2))             \
   8.258 +\            & SF(N1)_(x,y,sem,pc1,pc2) & [] SF(N2)_(x,y,sem,pc1,pc2)  \
   8.259 +\     --> (pc1 = #b | pc1 = #g | pc1 = #a ~> pc1 = #b)"
   8.260    (fn _ => [auto_tac (Inc_css addSIs2 [LatticeDisjunctionIntro]),
   8.261 -	    rtac (LatticeReflexivity RS tempD) 1,
   8.262 -	    rtac LatticeTransitivity 1,
   8.263 -	    auto_tac (Inc_css addSIs2 (map temp_mp [a1_leadsto_b1,g1_leadsto_a1])
   8.264 +	    rtac (temp_use LatticeReflexivity) 1,
   8.265 +	    rtac (temp_use LatticeTransitivity) 1,
   8.266 +	    auto_tac (Inc_css addSIs2 [a1_leadsto_b1,g1_leadsto_a1]
   8.267  		              addsimps2 [split_box_conj])
   8.268  	   ]);
   8.269  
   8.270  qed_goal "N1_live" Inc.thy
   8.271 -  "[](PsiInv .& [(N1 .| N2) .& .~ beta1]_<x,y,sem,pc1,pc2>)              \
   8.272 -\            .& SF(N1)_<x,y,sem,pc1,pc2> .& [] SF(N2)_<x,y,sem,pc1,pc2>  \
   8.273 -\  .-> <>($pc1 .= #b)"
   8.274 -  (fn _ => [auto_tac (Inc_css addSIs2 [(temp_mp N1_leadsto_b) RSN(2,leadsto_init)]),
   8.275 -	    rewrite_goals_tac (Init_def::action_rews),
   8.276 -	    exhaust_tac "pc1 (fst_st sigma)" 1,
   8.277 +  "|- []($PsiInv & [(N1 | N2) & ~beta1]_(x,y,sem,pc1,pc2))             \
   8.278 +\            & SF(N1)_(x,y,sem,pc1,pc2) & [] SF(N2)_(x,y,sem,pc1,pc2)  \
   8.279 +\     --> <>(pc1 = #b)"
   8.280 +  (fn _ => [auto_tac (Inc_css addsimps2 Init_defs
   8.281 +                              addSIs2 [(temp_use N1_leadsto_b) 
   8.282 +                                       RSN(2, temp_use leadsto_init)]),
   8.283 +	    exhaust_tac "pc1 (st1 sigma)" 1,
   8.284  	    Auto_tac
   8.285  	   ]);
   8.286  
   8.287  qed_goal "N1_enabled_at_b" Inc.thy
   8.288 -  "($pc1 .= #b) .-> $(Enabled (<N1>_<x,y,sem,pc1,pc2>))"
   8.289 -  (fn _ => [Action_simp_tac 1,
   8.290 +  "|- pc1 = #b --> Enabled (<N1>_(x,y,sem,pc1,pc2))"
   8.291 +  (fn _ => [Clarsimp_tac 1,
   8.292  	    res_inst_tac [("F","beta1")] enabled_mono 1,
   8.293  	    enabled_tac Inc_base 1,
   8.294  	    auto_tac (Inc_css addsimps2 [angle_def,beta1_def,N1_def])
   8.295 @@ -229,23 +223,21 @@
   8.296  
   8.297  (* Now assemble the bits and pieces to prove that Psi is fair. *)
   8.298  
   8.299 -goal Inc.thy  "[](PsiInv .& [(N1 .| N2)]_<x,y,sem,pc1,pc2>)              \
   8.300 -\            .& SF(N1)_<x,y,sem,pc1,pc2> .& [] SF(N2)_<x,y,sem,pc1,pc2>  \
   8.301 -\  .-> SF(M1)_<x,y>";
   8.302 -by (res_inst_tac [("B","beta1"),("P","$pc1 .= #b")] SF2 1);
   8.303 +qed_goal "Fair_M1_lemma" Inc.thy
   8.304 +  "|- []($PsiInv & [(N1 | N2)]_(x,y,sem,pc1,pc2))   \
   8.305 +\     & SF(N1)_(x,y,sem,pc1,pc2) & []SF(N2)_(x,y,sem,pc1,pc2)  \
   8.306 +\     --> SF(M1)_(x,y)"
   8.307 +  (fn _ => [ res_inst_tac [("B","beta1"),("P","PRED pc1 = #b")] SF2 1,
   8.308 +               (* action premises *)
   8.309 +             force_tac (Inc_css addsimps2 [angle_def,M1_def,beta1_def]) 1,
   8.310 +             force_tac (Inc_css addsimps2 angle_def::Psi_defs) 1,
   8.311 +             force_tac (Inc_css addSEs2 [N1_enabled_at_b]) 1,
   8.312 +               (* temporal premise: use previous lemmas and simple TL *)
   8.313 +             force_tac (Inc_css addSIs2 [DmdStable, N1_live,Stuck_at_b] 
   8.314 +                                addEs2 [STL4E] addsimps2 [square_def]) 1
   8.315 +            ]);
   8.316  
   8.317 -(* the action premises are simple *)
   8.318 -   by (force_tac (Inc_css addsimps2 [angle_def,M1_def,beta1_def]) 1);
   8.319 -  by (force_tac (Inc_css addsimps2 angle_def::Psi_defs) 1);
   8.320 - by (force_tac (Inc_css addSEs2 [action_mp N1_enabled_at_b]) 1);
   8.321 -(* temporal premise: use previous lemmas and simple TL *)
   8.322 -by (force_tac (Inc_css addSIs2 DmdStable::(map temp_mp [N1_live,Stuck_at_b]) 
   8.323 -                              addEs2 [STL4E] addsimps2 [square_def]) 1);
   8.324 -qed "Fair_M1_lemma";
   8.325 -
   8.326 -qed_goal "Fair_M1" Inc.thy "Psi .-> WF(M1)_<x,y>"
   8.327 -  (fn _ => [auto_tac (Inc_css addSIs2 SFImplWF::(map temp_mp [Fair_M1_lemma, PsiInv])
   8.328 -		              addsimps2 [split_box_conj]),
   8.329 -	    auto_tac (Inc_css addsimps2 Psi_def::more_temp_simps)
   8.330 +qed_goal "Fair_M1" Inc.thy "|- Psi --> WF(M1)_(x,y)"
   8.331 +  (fn _ => [auto_tac (Inc_css addSIs2 [SFImplWF, Fair_M1_lemma, PsiInv]
   8.332 +		              addsimps2 [Psi_def,split_box_conj]@more_temp_simps)
   8.333  	   ]);
   8.334 -
     9.1 --- a/src/HOL/TLA/Inc/Inc.thy	Mon Feb 08 13:02:42 1999 +0100
     9.2 +++ b/src/HOL/TLA/Inc/Inc.thy	Mon Feb 08 13:02:56 1999 +0100
     9.3 @@ -9,59 +9,62 @@
     9.4      Lamport's "increment" example.
     9.5  *)
     9.6  
     9.7 -Inc  =  TLA + Nat + Pcount +
     9.8 +Inc  =  TLA + Nat +
     9.9 +
    9.10 +(* program counter as an enumeration type *)
    9.11 +datatype pcount = a | b | g
    9.12  
    9.13  consts
    9.14    (* program variables *)
    9.15 -  x,y,sem                 :: "nat stfun"
    9.16 -  pc1,pc2                 :: "pcount stfun"
    9.17 +  x,y,sem                 :: nat stfun
    9.18 +  pc1,pc2                 :: pcount stfun
    9.19  
    9.20    (* names of actions and predicates *)
    9.21 -  M1,M2,N1,N2                             :: "action"
    9.22 -  alpha1,alpha2,beta1,beta2,gamma1,gamma2 :: "action"
    9.23 -  InitPhi, InitPsi                        :: "action"
    9.24 -  PsiInv,PsiInv1,PsiInv2,PsiInv3          :: "action"
    9.25 +  M1,M2,N1,N2                             :: action
    9.26 +  alpha1,alpha2,beta1,beta2,gamma1,gamma2 :: action
    9.27 +  InitPhi, InitPsi                        :: stpred
    9.28 +  PsiInv,PsiInv1,PsiInv2,PsiInv3          :: stpred
    9.29  
    9.30    (* temporal formulas *)
    9.31 -  Phi, Psi                                :: "temporal"
    9.32 +  Phi, Psi                                :: temporal
    9.33    
    9.34  rules
    9.35    (* the "base" variables, required to compute enabledness predicates *)
    9.36 -  Inc_base      "base_var <x, y, sem, pc1, pc2>"
    9.37 +  Inc_base      "basevars (x, y, sem, pc1, pc2)"
    9.38  
    9.39    (* definitions for high-level program *)
    9.40 -  InitPhi_def   "InitPhi == ($x .= # 0) .& ($y .= # 0)"
    9.41 -  M1_def        "M1      == (x$ .= Suc[$x]) .& (y$ .= $y)"
    9.42 -  M2_def        "M2      == (y$ .= Suc[$y]) .& (x$ .= $x)"
    9.43 -  Phi_def       "Phi     == Init(InitPhi) .& [][M1 .| M2]_<x,y> .&   \
    9.44 -\                           WF(M1)_<x,y> .& WF(M2)_<x,y>"
    9.45 +  InitPhi_def   "InitPhi == PRED x = # 0 & y = # 0"
    9.46 +  M1_def        "M1      == ACT  x` = Suc<$x> & y` = $y"
    9.47 +  M2_def        "M2      == ACT  y` = Suc<$y> & x` = $x"
    9.48 +  Phi_def       "Phi     == TEMP Init InitPhi & [][M1 | M2]_(x,y)
    9.49 +                                 & WF(M1)_(x,y) & WF(M2)_(x,y)"
    9.50  
    9.51    (* definitions for low-level program *)
    9.52 -  InitPsi_def   "InitPsi == ($pc1 .= #a) .& ($pc2 .= #a) .&   \
    9.53 -\                           ($x .= # 0) .& ($y .= # 0) .& ($sem .= Suc[# 0])"
    9.54 -  alpha1_def    "alpha1  == ($pc1 .= #a) .& (pc1$ .= #b) .& ($sem .= Suc[sem$]) .&   \
    9.55 -\                           unchanged(<x,y,pc2>)"
    9.56 -  alpha2_def    "alpha2  == ($pc2 .= #a) .& (pc2$ .= #b) .& ($sem .= Suc[sem$]) .&   \
    9.57 -\                           unchanged(<x,y,pc1>)"
    9.58 -  beta1_def     "beta1   == ($pc1 .= #b) .& (pc1$ .= #g) .& (x$ .= Suc[$x]) .&   \
    9.59 -\                           unchanged(<y,sem,pc2>)"
    9.60 -  beta2_def     "beta2   == ($pc2 .= #b) .& (pc2$ .= #g) .& (y$ .= Suc[$y]) .&   \
    9.61 -\                           unchanged(<x,sem,pc1>)"
    9.62 -  gamma1_def    "gamma1  == ($pc1 .= #g) .& (pc1$ .= #a) .& (sem$ .= Suc[$sem]) .&   \
    9.63 -\                           unchanged(<x,y,pc2>)"
    9.64 -  gamma2_def    "gamma2  == ($pc2 .= #g) .& (pc2$ .= #a) .& (sem$ .= Suc[$sem]) .&   \
    9.65 -\                           unchanged(<x,y,pc1>)"
    9.66 -  N1_def        "N1      == alpha1 .| beta1 .| gamma1"
    9.67 -  N2_def        "N2      == alpha2 .| beta2 .| gamma2"
    9.68 -  Psi_def       "Psi     == Init(InitPsi)   \
    9.69 -\                           .& [][N1 .| N2]_<x,y,sem,pc1,pc2>  \
    9.70 -\                           .& SF(N1)_<x,y,sem,pc1,pc2>  \
    9.71 -\                           .& SF(N2)_<x,y,sem,pc1,pc2>"
    9.72 +  InitPsi_def   "InitPsi == PRED pc1 = #a & pc2 = #a
    9.73 +                                 & x = # 0 & y = # 0 & sem = # 1"
    9.74 +  alpha1_def    "alpha1  == ACT  $pc1 = #a & pc1$ = #b & $sem = Suc<sem`> 
    9.75 +                                 & unchanged(x,y,pc2)"
    9.76 +  alpha2_def    "alpha2  == ACT  $pc2 = #a & pc2$ = #b & $sem = Suc<sem`>
    9.77 +                                 & unchanged(x,y,pc1)"
    9.78 +  beta1_def     "beta1   == ACT  $pc1 = #b & pc1$ = #g & x$ = Suc<$x>
    9.79 +                                 & unchanged(y,sem,pc2)"
    9.80 +  beta2_def     "beta2   == ACT  $pc2 = #b & pc2$ = #g & y$ = Suc<$y>
    9.81 +                                 & unchanged(x,sem,pc1)"
    9.82 +  gamma1_def    "gamma1  == ACT  $pc1 = #g & pc1$ = #a & sem$ = Suc<$sem>
    9.83 +                                 & unchanged(x,y,pc2)"
    9.84 +  gamma2_def    "gamma2  == ACT  $pc2 = #g & pc2$ = #a & sem$ = Suc<$sem>
    9.85 +                                 & unchanged(x,y,pc1)"
    9.86 +  N1_def        "N1      == ACT  (alpha1 | beta1 | gamma1)"
    9.87 +  N2_def        "N2      == ACT  (alpha2 | beta2 | gamma2)"
    9.88 +  Psi_def       "Psi     == TEMP Init InitPsi
    9.89 +                               & [][N1 | N2]_(x,y,sem,pc1,pc2)
    9.90 +                               & SF(N1)_(x,y,sem,pc1,pc2)
    9.91 +                               & SF(N2)_(x,y,sem,pc1,pc2)"
    9.92  
    9.93 -  PsiInv1_def  "PsiInv1  == ($sem .= Suc[# 0]) .& ($pc1 .= #a) .& ($pc2 .= #a)"
    9.94 -  PsiInv2_def  "PsiInv2  == ($sem .= # 0) .& ($pc1 .= #a) .& ($pc2 .= #b .| $pc2 .= #g)"
    9.95 -  PsiInv3_def  "PsiInv3  == ($sem .= # 0) .& ($pc2 .= #a) .& ($pc1 .= #b .| $pc1 .= #g)"
    9.96 -  PsiInv_def   "PsiInv   == PsiInv1 .| PsiInv2 .| PsiInv3"
    9.97 +  PsiInv1_def  "PsiInv1  == PRED sem = # 1 & pc1 = #a & pc2 = #a"
    9.98 +  PsiInv2_def  "PsiInv2  == PRED sem = # 0 & pc1 = #a & (pc2 = #b | pc2 = #g)"
    9.99 +  PsiInv3_def  "PsiInv3  == PRED sem = # 0 & pc2 = #a & (pc1 = #b | pc1 = #g)"
   9.100 +  PsiInv_def   "PsiInv   == PRED (PsiInv1 | PsiInv2 | PsiInv3)"
   9.101    
   9.102  end
   9.103  
    10.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    10.2 +++ b/src/HOL/TLA/Init.ML	Mon Feb 08 13:02:56 1999 +0100
    10.3 @@ -0,0 +1,43 @@
    10.4 +local
    10.5 +  fun prover s = prove_goal Init.thy s 
    10.6 +                    (K [force_tac (claset(), simpset() addsimps [Init_def]) 1])
    10.7 +in
    10.8 +  val const_simps = map (int_rewrite o prover)
    10.9 +      [ "|- (Init #True) = #True",
   10.10 +        "|- (Init #False) = #False"]
   10.11 +  val Init_simps = map (int_rewrite o prover)
   10.12 +      [ "|- (Init ~F) = (~ Init F)",
   10.13 +        "|- (Init (P --> Q)) = (Init P --> Init Q)",
   10.14 +        "|- (Init (P & Q)) = (Init P & Init Q)",
   10.15 +        "|- (Init (P | Q)) = (Init P | Init Q)",
   10.16 +        "|- (Init (P = Q)) = ((Init P) = (Init Q))",
   10.17 +        "|- (Init (!x. F x)) = (!x. (Init F x))",
   10.18 +        "|- (Init (? x. F x)) = (? x. (Init F x))",
   10.19 +        "|- (Init (?! x. F x)) = (?! x. (Init F x))"
   10.20 +      ]
   10.21 +end;
   10.22 +
   10.23 +Addsimps const_simps;
   10.24 +
   10.25 +Goal "|- (Init $P) = (Init P)";
   10.26 +by (force_tac (claset(), simpset() addsimps [Init_def,fw_act_def,fw_stp_def]) 1);
   10.27 +qed "Init_stp_act";
   10.28 +val Init_simps = (int_rewrite Init_stp_act)::Init_simps;
   10.29 +bind_thm("Init_stp_act_rev", symmetric(int_rewrite Init_stp_act));
   10.30 +
   10.31 +Goal "|- (Init F) = F";
   10.32 +by (force_tac (claset(), simpset() addsimps [Init_def,fw_temp_def]) 1);
   10.33 +qed "Init_temp";
   10.34 +val Init_simps = (int_rewrite Init_temp)::Init_simps;
   10.35 +
   10.36 +(* Trivial instances of the definitions that avoid introducing lambda expressions. *)
   10.37 +Goalw [Init_def,fw_stp_def] "(sigma |= Init P) = P (st1 sigma)";
   10.38 +by (rtac refl 1);
   10.39 +qed "Init_stp";
   10.40 +
   10.41 +Goalw [Init_def,fw_act_def] "(sigma |= Init A) = A (st1 sigma, st2 sigma)";
   10.42 +by (rtac refl 1);
   10.43 +qed "Init_act";
   10.44 +
   10.45 +val Init_defs = [Init_stp, Init_act, int_use Init_temp];
   10.46 +
    11.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    11.2 +++ b/src/HOL/TLA/Init.thy	Mon Feb 08 13:02:56 1999 +0100
    11.3 @@ -0,0 +1,46 @@
    11.4 +(* 
    11.5 +    File:	 TLA/Init.thy
    11.6 +    Author:      Stephan Merz
    11.7 +    Copyright:   1998 University of Munich
    11.8 +
    11.9 +    Theory Name: Init
   11.10 +    Logic Image: HOL
   11.11 +
   11.12 +Introduces type of temporal formulas. Defines interface between
   11.13 +temporal formulas and its "subformulas" (state predicates and actions).
   11.14 +*)
   11.15 +
   11.16 +Init  =  Action +
   11.17 +
   11.18 +types
   11.19 +  behavior
   11.20 +  temporal = behavior form
   11.21 +
   11.22 +arities
   11.23 +  behavior    :: term
   11.24 +
   11.25 +instance
   11.26 +  behavior    :: world
   11.27 +
   11.28 +consts
   11.29 +  Initial     :: ('w::world => bool) => temporal
   11.30 +  first_world :: behavior => ('w::world)
   11.31 +  st1, st2    :: behavior => state
   11.32 +
   11.33 +syntax
   11.34 +  TEMP       :: lift => 'a                          ("(TEMP _)")
   11.35 +  "_Init"    :: lift => lift                        ("(Init _)"[40] 50)
   11.36 +
   11.37 +translations
   11.38 +  "TEMP F"   => "(F::behavior => _)"
   11.39 +  "_Init"    == "Initial"
   11.40 +  "sigma |= Init F"  <= "_Init F sigma"
   11.41 +
   11.42 +defs
   11.43 +  Init_def    "sigma |= Init F  ==  (first_world sigma) |= F"
   11.44 +  fw_temp_def "first_world == %sigma. sigma"
   11.45 +  fw_stp_def  "first_world == st1"
   11.46 +  fw_act_def  "first_world == %sigma. (st1 sigma, st2 sigma)"
   11.47 +end
   11.48 +
   11.49 +ML
    12.1 --- a/src/HOL/TLA/IntLemmas.ML	Mon Feb 08 13:02:42 1999 +0100
    12.2 +++ b/src/HOL/TLA/IntLemmas.ML	Mon Feb 08 13:02:56 1999 +0100
    12.3 @@ -1,7 +1,7 @@
    12.4  (* 
    12.5      File:	 IntLemmas.ML
    12.6      Author:      Stephan Merz
    12.7 -    Copyright:   1997 University of Munich
    12.8 +    Copyright:   1998 University of Munich
    12.9  
   12.10  Lemmas and tactics for "intensional" logics. 
   12.11  
   12.12 @@ -12,32 +12,29 @@
   12.13  
   12.14  
   12.15  qed_goal "substW" Intensional.thy
   12.16 -  "[| x .= y; w |= (P::[('v::world) => 'a, 'w::world] => bool)(x) |] ==> w |= P(y)"
   12.17 +  "[| |- x = y; w |= P(x) |] ==> w |= P(y)"
   12.18    (fn [prem1,prem2] => [rtac (rewrite_rule ([prem1] RL [inteq_reflection]) prem2) 1]);
   12.19                          
   12.20  
   12.21  (* Lift HOL rules to intensional reasoning *)
   12.22  
   12.23 -qed_goal "reflW" Intensional.thy "x .= x"
   12.24 -  (fn _ => [ rtac intI 1,
   12.25 -             rewrite_goals_tac intensional_rews,
   12.26 -             rtac refl 1 ]);
   12.27 +qed_goal "reflW" Intensional.thy "|- x = x"
   12.28 +  (fn _ => [Simp_tac 1]);
   12.29  
   12.30 -
   12.31 -qed_goal "symW" Intensional.thy "s .= t ==> t .= s"
   12.32 +qed_goal "symW" Intensional.thy "|- s = t  ==>  |- t = s"
   12.33    (fn prems => [ cut_facts_tac prems 1,
   12.34                   rtac intI 1, dtac intD 1,
   12.35                   rewrite_goals_tac intensional_rews,
   12.36                   etac sym 1 ]);
   12.37  
   12.38 -qed_goal "not_symW" Intensional.thy "s .~= t ==> t .~= s"
   12.39 +qed_goal "not_symW" Intensional.thy "|- s ~= t  ==>  |- t ~= s"
   12.40    (fn prems => [ cut_facts_tac prems 1,
   12.41                   rtac intI 1, dtac intD 1,
   12.42                   rewrite_goals_tac intensional_rews,
   12.43                   etac not_sym 1 ]);
   12.44  
   12.45  qed_goal "transW" Intensional.thy 
   12.46 -  "[| r .= s; s .= t |] ==> r .= t"
   12.47 +  "[| |- r = s; |- s = t |] ==> |- r = t"
   12.48    (fn prems => [ cut_facts_tac prems 1,
   12.49                   rtac intI 1, REPEAT (dtac intD 1),
   12.50                   rewrite_goals_tac intensional_rews,
   12.51 @@ -45,36 +42,35 @@
   12.52                   atac 1 ]);
   12.53  
   12.54  qed_goal "box_equalsW" Intensional.thy 
   12.55 -   "[| a .= b; a .= c; b .= d |] ==> c .= d"
   12.56 +   "[| |- a = b; |- a = c; |- b = d |] ==> |- c = d"
   12.57     (fn prems => [ (rtac transW 1),
   12.58                    (rtac transW 1),
   12.59                    (rtac symW 1),
   12.60                    (REPEAT (resolve_tac prems 1)) ]);
   12.61  
   12.62  
   12.63 +(* NB: Antecedent is a standard HOL (non-intensional) formula. *)
   12.64  qed_goal "fun_congW" Intensional.thy 
   12.65 -   "(f::('a => 'b)) = g ==> f[x] .= g[x]"
   12.66 +   "f = g ==> |- f<x> = g<x>"
   12.67     (fn prems => [ cut_facts_tac prems 1,
   12.68                    rtac intI 1,
   12.69                    rewrite_goals_tac intensional_rews,
   12.70                    etac fun_cong 1 ]);
   12.71  
   12.72  qed_goal "fun_cong2W" Intensional.thy 
   12.73 -   "(f::(['a,'b] => 'c)) = g ==> f[x,y] .= g[x,y]"
   12.74 +   "f = g ==> |- f<x,y> = g<x,y>"
   12.75     (fn prems => [ cut_facts_tac prems 1,
   12.76                    rtac intI 1,
   12.77 -                  rewrite_goals_tac intensional_rews,
   12.78 -                  asm_full_simp_tac HOL_ss 1 ]);
   12.79 +                  Asm_full_simp_tac 1 ]);
   12.80  
   12.81  qed_goal "fun_cong3W" Intensional.thy 
   12.82 -   "(f::(['a,'b,'c] => 'd)) = g ==> f[x,y,z] .= g[x,y,z]"
   12.83 +   "f = g ==> |- f<x,y,z> = g<x,y,z>"
   12.84     (fn prems => [ cut_facts_tac prems 1,
   12.85                    rtac intI 1,
   12.86 -                  rewrite_goals_tac intensional_rews,
   12.87 -                  asm_full_simp_tac HOL_ss 1 ]);
   12.88 +                  Asm_full_simp_tac 1 ]);
   12.89  
   12.90  
   12.91 -qed_goal "arg_congW" Intensional.thy "x .= y ==> (f::'a=>'b)[x] .= f[y]"
   12.92 +qed_goal "arg_congW" Intensional.thy "|- x = y ==> |- f<x> = f<y>"
   12.93     (fn prems => [ cut_facts_tac prems 1,
   12.94                    rtac intI 1,
   12.95                    dtac intD 1,
   12.96 @@ -82,7 +78,7 @@
   12.97                    etac arg_cong 1 ]);
   12.98  
   12.99  qed_goal "arg_cong2W" Intensional.thy 
  12.100 -   "[| u .= v; x .= y |] ==> (f::['a,'b]=>'c)[u,x] .= f[v,y]"
  12.101 +   "[| |- u = v; |- x = y |] ==> |- f<u,x> = f<v,y>"
  12.102     (fn prems => [ cut_facts_tac prems 1,
  12.103                    rtac intI 1,
  12.104                    REPEAT (dtac intD 1),
  12.105 @@ -91,7 +87,7 @@
  12.106                    rtac refl 1 ]);
  12.107  
  12.108  qed_goal "arg_cong3W" Intensional.thy 
  12.109 -   "[| r .= s; u .= v; x .= y |] ==> (f::['a,'b,'c]=>'d)[r,u,x] .= f[s,v,y]"
  12.110 +   "[| |- r = s; |- u = v; |- x = y |] ==> |- f<r,u,x> = f<s,v,y>"
  12.111     (fn prems => [ cut_facts_tac prems 1,
  12.112                    rtac intI 1,
  12.113                    REPEAT (dtac intD 1),
  12.114 @@ -100,7 +96,7 @@
  12.115                    rtac refl 1 ]);
  12.116  
  12.117  qed_goal "congW" Intensional.thy 
  12.118 -   "[| (f::'a=>'b) = g; x .= y |] ==> f[x] .= g[y]"
  12.119 +   "[| f = g; |- x = y |] ==> |- f<x> = g<y>"
  12.120     (fn prems => [ rtac box_equalsW 1,
  12.121                    rtac reflW 3,
  12.122                    rtac arg_congW 1,
  12.123 @@ -110,7 +106,7 @@
  12.124                    resolve_tac prems 1 ]);
  12.125  
  12.126  qed_goal "cong2W" Intensional.thy 
  12.127 -   "[| (f::['a,'b]=>'c) = g; u .= v; x .= y |] ==> f[u,x] .= g[v,y]"
  12.128 +   "[| f = g; |- u = v; |- x = y |] ==> |- f<u,x> = g<v,y>"
  12.129     (fn prems => [ rtac box_equalsW 1,
  12.130                    rtac reflW 3,
  12.131                    rtac arg_cong2W 1,
  12.132 @@ -120,7 +116,7 @@
  12.133                    resolve_tac prems 1 ]);
  12.134  
  12.135  qed_goal "cong3W" Intensional.thy 
  12.136 -   "[| (f::['a,'b,'c]=>'d) = g; r .= s; u .= v; x .= y |] ==> (f[r,u,x]) .= (g[s,v,y])"
  12.137 +   "[| f = g; |- r = s; |- u = v; |- x = y |] ==> |- f<r,u,x> = g<s,v,y>"
  12.138     (fn prems => [ rtac box_equalsW 1,
  12.139                    rtac reflW 3,
  12.140                    rtac arg_cong3W 1,
  12.141 @@ -133,48 +129,38 @@
  12.142  (** Lifted equivalence **)
  12.143  
  12.144  (* Note the object-level implication in the hypothesis. Meta-level implication
  12.145 -   would not be correct! *)
  12.146 +   would be incorrect! *)
  12.147  qed_goal "iffIW" Intensional.thy 
  12.148 -  "[| A .-> B; B .-> A |] ==> A .= B"
  12.149 +  "[| |- A --> B; |- B --> A |] ==> |- A = B"
  12.150    (fn prems => [ cut_facts_tac prems 1,
  12.151 -                 rtac intI 1,
  12.152 -                 REPEAT (dtac intD 1),
  12.153 -                 rewrite_goals_tac intensional_rews,
  12.154 -                 (fast_tac prop_cs 1) ]);
  12.155 +                 rewrite_goals_tac (Valid_def::intensional_rews),
  12.156 +                 Blast_tac 1 ]);
  12.157  
  12.158  qed_goal "iffD2W" Intensional.thy 
  12.159 -  "[| (P::('w::world) form) .= Q; w |= Q |] ==> w |= P"
  12.160 - (fn prems =>
  12.161 -	[cut_facts_tac prems 1,
  12.162 -         dtac intD 1,
  12.163 -         rewrite_goals_tac intensional_rews,
  12.164 -         fast_tac prop_cs 1 ]);
  12.165 +  "[| |- P = Q; w |= Q |] ==> w |= P"
  12.166 + (fn prems => [ cut_facts_tac prems 1,
  12.167 +	        rewrite_goals_tac (Valid_def::intensional_rews),
  12.168 +                Blast_tac 1 ]);
  12.169  
  12.170  val iffD1W = symW RS iffD2W;
  12.171  
  12.172  (** #True **)
  12.173  
  12.174 -qed_goal "TrueIW" Intensional.thy "#True"
  12.175 -  (fn _ => [rtac intI 1, rewrite_goals_tac intensional_rews, rtac TrueI 1]);
  12.176 -
  12.177 -
  12.178 -qed_goal "eqTrueIW" Intensional.thy "(P::('w::world) form) ==> P .= #True"
  12.179 +qed_goal "eqTrueIW" Intensional.thy "|- P ==> |- P = #True"
  12.180    (fn prems => [cut_facts_tac prems 1,
  12.181                  rtac intI 1,
  12.182                  dtac intD 1,
  12.183 -                rewrite_goals_tac intensional_rews,
  12.184 -                asm_full_simp_tac HOL_ss 1] );
  12.185 +		Asm_full_simp_tac 1]);
  12.186  
  12.187 -qed_goal "eqTrueEW" Intensional.thy "P .= #True ==> (P::('w::world) form)" 
  12.188 +qed_goal "eqTrueEW" Intensional.thy "|- P = #True ==> |- P"
  12.189    (fn prems => [cut_facts_tac prems 1,
  12.190                  rtac intI 1,
  12.191                  dtac intD 1,
  12.192 -                rewrite_goals_tac intensional_rews,
  12.193 -                asm_full_simp_tac HOL_ss 1] );
  12.194 +		Asm_full_simp_tac 1]);
  12.195  
  12.196  (** #False **)
  12.197  
  12.198 -qed_goal "FalseEW" Intensional.thy "#False ==> P::('w::world) form"
  12.199 +qed_goal "FalseEW" Intensional.thy "|- #False ==> |- P"
  12.200    (fn prems => [cut_facts_tac prems 1,
  12.201                  rtac intI 1,
  12.202                  dtac intD 1,
  12.203 @@ -182,23 +168,20 @@
  12.204                  etac FalseE 1]);
  12.205  
  12.206  qed_goal "False_neq_TrueW" Intensional.thy 
  12.207 - "(#False::('w::world) form) .= #True ==> P::('w::world) form"
  12.208 + "|- #False = #True ==> |- P"
  12.209   (fn [prem] => [rtac (prem RS eqTrueEW RS FalseEW) 1]);
  12.210  
  12.211  
  12.212  (** Negation **)
  12.213  
  12.214  (* Again use object-level implication *)
  12.215 -qed_goal "notIW" Intensional.thy "(P .-> #False) ==> .~P"
  12.216 +qed_goal "notIW" Intensional.thy "|- P --> #False ==> |- ~P"
  12.217    (fn prems => [cut_facts_tac prems 1,
  12.218 -                rtac intI 1,
  12.219 -                dtac intD 1,
  12.220 -                rewrite_goals_tac intensional_rews,
  12.221 -                fast_tac prop_cs 1]);
  12.222 -
  12.223 +		rewrite_goals_tac (Valid_def::intensional_rews),
  12.224 +		Blast_tac 1]);
  12.225  
  12.226  qed_goal "notEWV" Intensional.thy 
  12.227 -  "[| .~P; P::('w::world) form |] ==> R::('w::world) form"
  12.228 +  "[| |- ~P; |- P |] ==> |- R"
  12.229    (fn prems => [cut_facts_tac prems 1,
  12.230  		rtac intI 1,
  12.231                  REPEAT (dtac intD 1),
  12.232 @@ -210,7 +193,7 @@
  12.233     are allowed to be (intensional) formulas of different types! *)
  12.234  
  12.235  qed_goal "notEW" Intensional.thy 
  12.236 -   "[| w |= .~P; w |= P |] ==> R::('w::world) form"
  12.237 +   "[| w |= ~P; w |= P |] ==> |- R"
  12.238    (fn prems => [cut_facts_tac prems 1,
  12.239                  rtac intI 1,
  12.240                  rewrite_goals_tac intensional_rews,
  12.241 @@ -218,14 +201,14 @@
  12.242  
  12.243  (** Implication **)
  12.244  
  12.245 -qed_goal "impIW" Intensional.thy "(!!w. (w |= A) ==> (w |= B)) ==> A .-> B"
  12.246 +qed_goal "impIW" Intensional.thy "(!!w. (w |= A) ==> (w |= B)) ==> |- A --> B"
  12.247    (fn [prem] => [ rtac intI 1,
  12.248                   rewrite_goals_tac intensional_rews,
  12.249                   rtac impI 1,
  12.250                   etac prem 1 ]);
  12.251  
  12.252  
  12.253 -qed_goal "mpW" Intensional.thy "[| A .-> B; w |= A |] ==> w |= B"
  12.254 +qed_goal "mpW" Intensional.thy "[| |- A --> B; w |= A |] ==> w |= B"
  12.255     (fn prems => [ cut_facts_tac prems 1,
  12.256                    dtac intD 1,
  12.257                    rewrite_goals_tac intensional_rews,
  12.258 @@ -233,124 +216,111 @@
  12.259                    atac 1 ]);
  12.260  
  12.261  qed_goal "impEW" Intensional.thy 
  12.262 -  "[| A .-> B; w |= A; w |= B ==> w |= C |] ==> w |= (C::('w::world) form)"
  12.263 +  "[| |- A --> B; w |= A; w |= B ==> w |= C |] ==> w |= C"
  12.264    (fn prems => [ (REPEAT (resolve_tac (prems@[mpW]) 1)) ]);
  12.265  
  12.266 -qed_goal "rev_mpW" Intensional.thy "[| w |= P; P .-> Q |] ==> w |= Q"
  12.267 +qed_goal "rev_mpW" Intensional.thy "[| w |= P; |- P --> Q |] ==> w |= Q"
  12.268    (fn prems => [ (REPEAT (resolve_tac (prems@[mpW]) 1)) ]);
  12.269  
  12.270 -qed_goal "contraposW" Intensional.thy "[| w |= .~Q; P .-> Q |] ==> w |= .~P"
  12.271 -  (fn [major,minor] => [rewrite_goals_tac intensional_rews,
  12.272 -                        rtac contrapos 1,
  12.273 -                        rtac (rewrite_rule intensional_rews major) 1,
  12.274 +qed_goalw "contraposW" Intensional.thy intensional_rews
  12.275 +  "[| w |= ~Q; |- P --> Q |] ==> w |= ~P"
  12.276 +  (fn [major,minor] => [rtac (major RS contrapos) 1,
  12.277                          etac rev_mpW 1,
  12.278                          rtac minor 1]);
  12.279  
  12.280  qed_goal "iffEW" Intensional.thy
  12.281 -    "[| (P::('w::world) form) .= Q; [| P .-> Q; Q .-> P |] ==> R::('w::world) form |] ==> R"
  12.282 +    "[| |- P = Q; [| |- P --> Q; |- Q --> P |] ==> R |] ==> R"
  12.283   (fn [p1,p2] => [REPEAT(ares_tac([p1 RS iffD2W, p1 RS iffD1W, p2, impIW])1)]);
  12.284  
  12.285  
  12.286  (** Conjunction **)
  12.287  
  12.288 -qed_goal "conjIW" Intensional.thy "[| w |= P; w |= Q |] ==> w |= P .& Q"
  12.289 -  (fn prems => [rewrite_goals_tac intensional_rews,
  12.290 -                REPEAT (resolve_tac ([conjI]@prems) 1)]);
  12.291 +qed_goalw "conjIW" Intensional.thy intensional_rews "[| w |= P; w |= Q |] ==> w |= P & Q"
  12.292 +  (fn prems => [REPEAT (resolve_tac ([conjI]@prems) 1)]);
  12.293  
  12.294 -qed_goal "conjunct1W" Intensional.thy "(w |= P .& Q) ==> w |= P"
  12.295 +qed_goal "conjunct1W" Intensional.thy "(w |= P & Q) ==> w |= P"
  12.296    (fn prems => [cut_facts_tac prems 1,
  12.297                  rewrite_goals_tac intensional_rews,
  12.298                  etac conjunct1 1]);
  12.299  
  12.300 -qed_goal "conjunct2W" Intensional.thy "(w |= P .& Q) ==> w |= Q"
  12.301 +qed_goal "conjunct2W" Intensional.thy "(w |= P & Q) ==> w |= Q"
  12.302    (fn prems => [cut_facts_tac prems 1,
  12.303                  rewrite_goals_tac intensional_rews,
  12.304                  etac conjunct2 1]);
  12.305  
  12.306  qed_goal "conjEW" Intensional.thy 
  12.307 -  "[| w |= P .& Q; [| w |= P; w |= Q |] ==> w |= R |] ==> w |= (R::('w::world) form)"
  12.308 +  "[| w |= P & Q; [| w |= P; w |= Q |] ==> w |= R |] ==> w |= R"
  12.309    (fn prems => [cut_facts_tac prems 1, resolve_tac prems 1,
  12.310  	        etac conjunct1W 1, etac conjunct2W 1]);
  12.311  
  12.312  
  12.313  (** Disjunction **)
  12.314  
  12.315 -qed_goal "disjI1W" Intensional.thy "w |= P ==> w |= P .| Q"
  12.316 -  (fn [prem] => [rewrite_goals_tac intensional_rews,
  12.317 -                 rtac disjI1 1,
  12.318 -                 rtac prem 1]);
  12.319 +qed_goalw "disjI1W" Intensional.thy intensional_rews "w |= P ==> w |= P | Q"
  12.320 +  (fn [prem] => [REPEAT (resolve_tac [disjI1,prem] 1)]);
  12.321  
  12.322 -qed_goal "disjI2W" Intensional.thy "w |= Q ==> w |= P .| Q"
  12.323 -  (fn [prem] => [rewrite_goals_tac intensional_rews,
  12.324 -                 rtac disjI2 1,
  12.325 -                 rtac prem 1]);
  12.326 +qed_goalw "disjI2W" Intensional.thy intensional_rews "w |= Q ==> w |= P | Q"
  12.327 +  (fn [prem] => [REPEAT (resolve_tac [disjI2,prem] 1)]);
  12.328  
  12.329  qed_goal "disjEW" Intensional.thy 
  12.330 -         "[| w |= P .| Q; P .-> R; Q .-> R |] ==> w |= R"
  12.331 +         "[| w |= P | Q; |- P --> R; |- Q --> R |] ==> w |= R"
  12.332    (fn prems => [cut_facts_tac prems 1,
  12.333                  REPEAT (dtac intD 1),
  12.334                  rewrite_goals_tac intensional_rews,
  12.335 -                fast_tac prop_cs 1]);
  12.336 +		Blast_tac 1]);
  12.337  
  12.338  (** Classical propositional logic **)
  12.339  
  12.340 -qed_goal "classicalW" Intensional.thy "(.~P .-> P) ==> P::('w::world)form"
  12.341 -  (fn prems => [cut_facts_tac prems 1,
  12.342 -                rtac intI 1,
  12.343 -                dtac intD 1,
  12.344 -                rewrite_goals_tac intensional_rews,
  12.345 -                fast_tac prop_cs 1]);
  12.346 +qed_goalw "classicalW" Intensional.thy (Valid_def::intensional_rews)
  12.347 +  "!!P. |- ~P --> P  ==>  |- P"
  12.348 +  (fn prems => [Blast_tac 1]);
  12.349  
  12.350 -qed_goal "notnotDW" Intensional.thy ".~.~P ==> P::('w::world) form"
  12.351 -  (fn prems => [cut_facts_tac prems 1,
  12.352 -                rtac intI 1,
  12.353 +qed_goal "notnotDW" Intensional.thy "!!P. |- ~~P  ==>  |- P"
  12.354 +  (fn prems => [rtac intI 1,
  12.355                  dtac intD 1,
  12.356                  rewrite_goals_tac intensional_rews,
  12.357                  etac notnotD 1]);
  12.358  
  12.359 -qed_goal "disjCIW" Intensional.thy "(w |= .~Q .-> P) ==> (w |= P.|Q)"
  12.360 -  (fn prems => [cut_facts_tac prems 1,
  12.361 -                rewrite_goals_tac intensional_rews,
  12.362 -                fast_tac prop_cs 1]);
  12.363 +qed_goal "disjCIW" Intensional.thy "!!P Q. (w |= ~Q --> P) ==> (w |= P|Q)"
  12.364 +  (fn prems => [rewrite_goals_tac intensional_rews,
  12.365 +                Blast_tac 1]);
  12.366  
  12.367  qed_goal "impCEW" Intensional.thy 
  12.368 -   "[| P.->Q; (w |= .~P) ==> (w |= R); (w |= Q) ==> (w |= R) |] ==> w |= (R::('w::world) form)"
  12.369 +   "[| |- P --> Q; (w |= ~P) ==> (w |= R); (w |= Q) ==> (w |= R) |] ==> w |= R"
  12.370    (fn [a1,a2,a3] => 
  12.371      [rtac (excluded_middle RS disjE) 1,
  12.372       etac (rewrite_rule intensional_rews a2) 1,
  12.373       rtac a3 1,
  12.374       etac (a1 RS mpW) 1]);
  12.375  
  12.376 -(* The following generates too many parse trees...
  12.377 -
  12.378 -qed_goal "iffCEW" Intensional.thy
  12.379 -   "[| P .= Q;      \
  12.380 +qed_goalw "iffCEW" Intensional.thy intensional_rews
  12.381 +   "[| |- P = Q;      \
  12.382  \      [| (w |= P); (w |= Q) |] ==> (w |= R);   \
  12.383 -\      [| (w |= .~P); (w |= .~Q) |] ==> (w |= R)  \
  12.384 -\   |] ==> w |= (R::('w::world) form)"
  12.385 -
  12.386 -*)
  12.387 +\      [| (w |= ~P); (w |= ~Q) |] ==> (w |= R)  \
  12.388 +\   |] ==> w |= R"
  12.389 +   (fn [a1,a2,a3] =>
  12.390 +      [rtac iffCE 1,
  12.391 +       etac a2 2, atac 2,
  12.392 +       etac a3 2, atac 2,
  12.393 +       rtac (int_unlift a1) 1]);
  12.394  
  12.395  qed_goal "case_split_thmW" Intensional.thy 
  12.396 -   "[| P .-> Q; .~P .-> Q |] ==> Q::('w::world) form"
  12.397 -  (fn prems => [cut_facts_tac prems 1,
  12.398 -                rtac intI 1,
  12.399 -                REPEAT (dtac intD 1),
  12.400 -                rewrite_goals_tac intensional_rews,
  12.401 -                fast_tac prop_cs 1]);
  12.402 +   "!!P. [| |- P --> Q; |- ~P --> Q |] ==> |- Q"
  12.403 +  (fn _ => [rewrite_goals_tac (Valid_def::intensional_rews),
  12.404 +	    Blast_tac 1]);
  12.405  
  12.406  fun case_tacW a = res_inst_tac [("P",a)] case_split_thmW;
  12.407  
  12.408  
  12.409  (** Rigid quantifiers **)
  12.410  
  12.411 -qed_goal "allIW" Intensional.thy "(!!x. P(x)) ==> RALL x. P(x)"
  12.412 +qed_goal "allIW" Intensional.thy "(!!x. |- P x) ==> |- ! x. P(x)"
  12.413    (fn [prem] => [rtac intI 1,
  12.414                   rewrite_goals_tac intensional_rews,
  12.415                   rtac allI 1,
  12.416 -                 rtac (prem RS intE) 1]);
  12.417 +                 rtac (prem RS intD) 1]);
  12.418  
  12.419 -qed_goal "specW" Intensional.thy "(RALL x. P(x)) ==> P(x)"
  12.420 +qed_goal "specW" Intensional.thy "|- ! x. P x ==> |- P x"
  12.421    (fn prems => [cut_facts_tac prems 1,
  12.422                  rtac intI 1,
  12.423                  dtac intD 1,
  12.424 @@ -359,24 +329,24 @@
  12.425  
  12.426  
  12.427  qed_goal "allEW" Intensional.thy 
  12.428 -         "[| RALL x. P(x);  P(x) ==> R |] ==> R::('w::world) form"
  12.429 +         "[| |- ! x. P x;  |- P x ==> |- R |] ==> |- R"
  12.430   (fn major::prems=>
  12.431    [ (REPEAT (resolve_tac (prems @ [major RS specW]) 1)) ]);
  12.432  
  12.433  qed_goal "all_dupEW" Intensional.thy 
  12.434 -    "[| RALL x. P(x);  [| P(x); RALL x. P(x) |] ==> R |] ==> R::('w::world) form"
  12.435 +    "[| |- ! x. P x;  [| |- P x; |- ! x. P x |] ==> |- R |] ==> |- R"
  12.436   (fn prems =>
  12.437    [ (REPEAT (resolve_tac (prems @ (prems RL [specW])) 1)) ]);
  12.438  
  12.439  
  12.440 -qed_goal "exIW" Intensional.thy "P(x) ==> REX x. P(x)"
  12.441 +qed_goal "exIW" Intensional.thy "|- P x ==> |- ? x. P x"
  12.442    (fn [prem] => [rtac intI 1,
  12.443                   rewrite_goals_tac intensional_rews,
  12.444                   rtac exI 1,
  12.445                   rtac (prem RS intD) 1]);
  12.446  
  12.447  qed_goal "exEW" Intensional.thy 
  12.448 -  "[| w |= REX x. P(x); !!x. P(x) .-> Q |] ==> w |= Q"
  12.449 +  "[| w |= ? x. P x; !!x. |- P x --> Q |] ==> w |= Q"
  12.450    (fn [major,minor] => [rtac exE 1,
  12.451                          rtac (rewrite_rule intensional_rews major) 1,
  12.452                          etac rev_mpW 1,
  12.453 @@ -385,8 +355,7 @@
  12.454  (** Classical quantifier reasoning **)
  12.455  
  12.456  qed_goal "exCIW" Intensional.thy 
  12.457 -  "(w |= (RALL x. .~P(x)) .-> P(a)) ==> w |= REX x. P(x)"
  12.458 -  (fn prems => [cut_facts_tac prems 1,
  12.459 -                rewrite_goals_tac intensional_rews,
  12.460 -                fast_tac HOL_cs 1]);
  12.461 +  "!!P. w |= (! x. ~P x) --> P a ==> w |= ? x. P x"
  12.462 +  (fn prems => [rewrite_goals_tac intensional_rews,
  12.463 +                Blast_tac 1]);
  12.464  
    13.1 --- a/src/HOL/TLA/Intensional.ML	Mon Feb 08 13:02:42 1999 +0100
    13.2 +++ b/src/HOL/TLA/Intensional.ML	Mon Feb 08 13:02:56 1999 +0100
    13.3 @@ -1,204 +1,136 @@
    13.4  (* 
    13.5      File:	 Intensional.ML
    13.6      Author:      Stephan Merz
    13.7 -    Copyright:   1997 University of Munich
    13.8 +    Copyright:   1998 University of Munich
    13.9  
   13.10  Lemmas and tactics for "intensional" logics.
   13.11  *)
   13.12  
   13.13 -val intensional_rews = [unl_con,unl_lift,unl_lift2,unl_lift3,unl_Rall,unl_Rex];
   13.14 +val intensional_rews = [unl_con,unl_lift,unl_lift2,unl_lift3,unl_Rall,unl_Rex,unl_Rex1];
   13.15 +
   13.16 +qed_goalw "inteq_reflection" Intensional.thy  [Valid_def,unl_lift2]
   13.17 +  "|- x=y  ==>  (x==y)"
   13.18 +  (fn [prem] => [rtac eq_reflection 1, rtac ext 1, rtac (prem RS spec) 1 ]);
   13.19  
   13.20 -(** Lift usual HOL simplifications to "intensional" level. 
   13.21 -    Convert s .= t into rewrites s == t, so we can use the standard 
   13.22 -    simplifier.
   13.23 -**)
   13.24 +qed_goalw "intI" Intensional.thy [Valid_def] "(!!w. w |= A) ==> |- A"
   13.25 +  (fn [prem] => [REPEAT (resolve_tac [allI,prem] 1)]);
   13.26 +
   13.27 +qed_goalw "intD" Intensional.thy [Valid_def] "|- A ==> w |= A"
   13.28 +  (fn [prem] => [rtac (prem RS spec) 1]);
   13.29 +
   13.30 +
   13.31 +(** Lift usual HOL simplifications to "intensional" level. **)
   13.32  local
   13.33  
   13.34  fun prover s = (prove_goal Intensional.thy s 
   13.35 -                 (fn _ => [rewrite_goals_tac (int_valid::intensional_rews), 
   13.36 -                           blast_tac HOL_cs 1])) RS inteq_reflection;
   13.37 +                 (fn _ => [rewrite_goals_tac (Valid_def::intensional_rews), 
   13.38 +                           blast_tac HOL_cs 1])) RS inteq_reflection
   13.39  
   13.40  in
   13.41  
   13.42  val int_simps = map prover
   13.43 - [ "(x.=x) .= #True",
   13.44 -   "(.~#True) .= #False", "(.~#False) .= #True", "(.~ .~ P) .= P",
   13.45 -   "((.~P) .= P) .= #False", "(P .= (.~P)) .= #False", 
   13.46 -   "(P .~= Q) .= (P .= (.~Q))",
   13.47 -   "(#True.=P) .= P", "(P.=#True) .= P",
   13.48 -   "(#True .-> P) .= P", "(#False .-> P) .= #True", 
   13.49 -   "(P .-> #True) .= #True", "(P .-> P) .= #True",
   13.50 -   "(P .-> #False) .= (.~P)", "(P .-> .~P) .= (.~P)",
   13.51 -   "(P .& #True) .= P", "(#True .& P) .= P", 
   13.52 -   "(P .& #False) .= #False", "(#False .& P) .= #False", 
   13.53 -   "(P .& P) .= P", "(P .& .~P) .= #False", "(.~P .& P) .= #False",
   13.54 -   "(P .| #True) .= #True", "(#True .| P) .= #True", 
   13.55 -   "(P .| #False) .= P", "(#False .| P) .= P", 
   13.56 -   "(P .| P) .= P", "(P .| .~P) .= #True", "(.~P .| P) .= #True",
   13.57 -   "(RALL x. P) .= P", "(REX x. P) .= P",
   13.58 -   "(.~Q .-> .~P) .= (P .-> Q)",
   13.59 -   "(P.|Q .-> R) .= ((P.->R).&(Q.->R))" ];
   13.60 -
   13.61 + [ "|- (x=x) = #True",
   13.62 +   "|- (~#True) = #False", "|- (~#False) = #True", "|- (~~ P) = P",
   13.63 +   "|- ((~P) = P) = #False", "|- (P = (~P)) = #False", 
   13.64 +   "|- (P ~= Q) = (P = (~Q))",
   13.65 +   "|- (#True=P) = P", "|- (P=#True) = P",
   13.66 +   "|- (#True --> P) = P", "|- (#False --> P) = #True", 
   13.67 +   "|- (P --> #True) = #True", "|- (P --> P) = #True",
   13.68 +   "|- (P --> #False) = (~P)", "|- (P --> ~P) = (~P)",
   13.69 +   "|- (P & #True) = P", "|- (#True & P) = P", 
   13.70 +   "|- (P & #False) = #False", "|- (#False & P) = #False", 
   13.71 +   "|- (P & P) = P", "|- (P & ~P) = #False", "|- (~P & P) = #False",
   13.72 +   "|- (P | #True) = #True", "|- (#True | P) = #True", 
   13.73 +   "|- (P | #False) = P", "|- (#False | P) = P", 
   13.74 +   "|- (P | P) = P", "|- (P | ~P) = #True", "|- (~P | P) = #True",
   13.75 +   "|- (! x. P) = P", "|- (? x. P) = P", 
   13.76 +   "|- (~Q --> ~P) = (P --> Q)",
   13.77 +   "|- (P|Q --> R) = ((P-->R)&(Q-->R))" ];
   13.78  end;
   13.79  
   13.80 -Addsimps (intensional_rews @ int_simps);
   13.81 +qed_goal "TrueW" Intensional.thy "|- #True"
   13.82 +  (fn _ => [simp_tac (simpset() addsimps [Valid_def,unl_con]) 1]);
   13.83  
   13.84 -(* Derive introduction and destruction rules from definition of 
   13.85 -   intensional validity.
   13.86 -*)
   13.87 -qed_goal "intI" Intensional.thy "(!!w. w |= A) ==> A"
   13.88 -  (fn prems => [rewtac int_valid,
   13.89 -                resolve_tac prems 1
   13.90 -               ]);
   13.91 +Addsimps (TrueW::intensional_rews);
   13.92 +Addsimps int_simps;
   13.93 +AddSIs [intI];
   13.94 +AddDs  [intD];
   13.95  
   13.96 -qed_goalw "intD" Intensional.thy [int_valid] "A ==> w |= A"
   13.97 -  (fn [prem] => [ rtac (forall_elim_var 0 prem) 1 ]);
   13.98  
   13.99  (* ======== Functions to "unlift" intensional implications into HOL rules ====== *)
  13.100  
  13.101  (* Basic unlifting introduces a parameter "w" and applies basic rewrites, e.g.
  13.102 -   F .= G    gets   (w |= F) = (w |= G)
  13.103 -   F .-> G   gets   (w |= F) --> (w |= G)
  13.104 -*)
  13.105 -fun int_unlift th = rewrite_rule intensional_rews (th RS intD);
  13.106 -
  13.107 -(* F .-> G   becomes   w |= F  ==>  w |= G *)
  13.108 -fun int_mp th = zero_var_indexes ((int_unlift th) RS mp);
  13.109 -
  13.110 -(* F .-> G   becomes   [| w |= F; w |= G ==> R |] ==> R 
  13.111 -   so that it can be used as an elimination rule
  13.112 -*)
  13.113 -fun int_impE th = zero_var_indexes ((int_unlift th) RS impE);
  13.114 -
  13.115 -(* F .& G .-> H  becomes  [| w |= F; w |= G |] ==> w |= H *)
  13.116 -fun int_conjmp th = zero_var_indexes (conjI RS (int_mp th));
  13.117 -
  13.118 -(* F .& G .-> H  becomes  [| w |= F; w |= G; (w |= H ==> R) |] ==> R *)
  13.119 -fun int_conjimpE th = zero_var_indexes (conjI RS (int_impE th));
  13.120 -
  13.121 -(* Turn  F .= G  into meta-level rewrite rule  F == G *)
  13.122 -fun int_rewrite th = (rewrite_rule intensional_rews (th RS inteq_reflection));
  13.123 -
  13.124 -(* Make the simplifier accept "intensional" goals by first unlifting them.
  13.125 -   This is the standard way of proving "intensional" theorems; apply
  13.126 -   int_rewrite (or action_rewrite, temp_rewrite) to convert "x .= y" into "x == y"
  13.127 -   if you want to rewrite without unlifting.
  13.128 -*)
  13.129 -fun maybe_unlift th =
  13.130 -    (case concl_of th of
  13.131 -	 Const("Intensional.TrueInt",_) $ p => int_unlift th
  13.132 -       | _ => th);
  13.133 -
  13.134 -simpset_ref() := simpset() setmksimps ((mksimps mksimps_pairs) o maybe_unlift);
  13.135 -
  13.136 -
  13.137 -(* ==================== Rewrites for abstractions ==================== *)
  13.138 -
  13.139 -(* The following are occasionally useful. Don't add them to the default
  13.140 -   simpset, or it will loop! Alternatively, we could replace the "unl_XXX"
  13.141 -   rules by definitions of lifting via lambda abstraction, but then proof
  13.142 -   states would have lots of lambdas, and would be hard to read.
  13.143 +   |- F = G    becomes   F w = G w
  13.144 +   |- F --> G  becomes   F w --> G w
  13.145  *)
  13.146  
  13.147 -qed_goal "con_abs" Intensional.thy "(%w. c) == #c"
  13.148 -  (fn _ => [rtac inteq_reflection 1,
  13.149 -            rtac intI 1,
  13.150 -            rewrite_goals_tac intensional_rews,
  13.151 -            rtac refl 1
  13.152 -           ]);
  13.153 +fun int_unlift th =
  13.154 +  rewrite_rule intensional_rews ((th RS intD) handle _ => th);
  13.155  
  13.156 -qed_goal "lift_abs" Intensional.thy "(%w. f(x w)) == (f[x])"
  13.157 -  (fn _ => [rtac inteq_reflection 1,
  13.158 -            rtac intI 1,
  13.159 -            rewrite_goals_tac intensional_rews,
  13.160 -            rtac refl 1
  13.161 -           ]);
  13.162 +(* Turn  |- F = G  into meta-level rewrite rule  F == G *)
  13.163 +fun int_rewrite th = 
  13.164 +    zero_var_indexes (rewrite_rule intensional_rews (th RS inteq_reflection));
  13.165  
  13.166 -qed_goal "lift2_abs" Intensional.thy "(%w. f(x w) (y w)) == (f[x,y])"
  13.167 -  (fn _ => [rtac inteq_reflection 1,
  13.168 -            rtac intI 1,
  13.169 -            rewrite_goals_tac intensional_rews,
  13.170 -            rtac refl 1
  13.171 -           ]);
  13.172 +(* flattening turns "-->" into "==>" and eliminates conjunctions in the
  13.173 +   antecedent. For example,
  13.174 +
  13.175 +         P & Q --> (R | S --> T)    becomes   [| P; Q; R | S |] ==> T
  13.176  
  13.177 -qed_goal "lift2_abs_con1" Intensional.thy "(%w. f x (y w)) == (f[#x,y])"
  13.178 -  (fn _ => [rtac inteq_reflection 1,
  13.179 -            rtac intI 1,
  13.180 -            rewrite_goals_tac intensional_rews,
  13.181 -            rtac refl 1
  13.182 -           ]);
  13.183 -
  13.184 -qed_goal "lift2_abs_con2" Intensional.thy "(%w. f(x w) y) == (f[x,#y])"
  13.185 -  (fn _ => [rtac inteq_reflection 1,
  13.186 -            rtac intI 1,
  13.187 -            rewrite_goals_tac intensional_rews,
  13.188 -            rtac refl 1
  13.189 -           ]);
  13.190 -
  13.191 -qed_goal "lift3_abs" Intensional.thy "(%w. f(x w) (y w) (z w)) == (f[x,y,z])"
  13.192 -  (fn _ => [rtac inteq_reflection 1,
  13.193 -            rtac intI 1,
  13.194 -            rewrite_goals_tac intensional_rews,
  13.195 -            rtac refl 1
  13.196 -           ]);
  13.197 +   Flattening can be useful with "intensional" lemmas (after unlifting).
  13.198 +   Naive resolution with mp and conjI may run away because of higher-order
  13.199 +   unification, therefore the code is a little awkward.
  13.200 +*)
  13.201 +fun flatten t =
  13.202 +  let 
  13.203 +    (* analogous to RS, but using matching instead of resolution *)
  13.204 +    fun matchres tha i thb =
  13.205 +      case Seq.chop (2, biresolution true [(false,tha)] i thb) of
  13.206 +	  ([th],_) => th
  13.207 +	| ([],_)   => raise THM("matchres: no match", i, [tha,thb])
  13.208 +	|      _   => raise THM("matchres: multiple unifiers", i, [tha,thb])
  13.209  
  13.210 -qed_goal "lift3_abs_con1" Intensional.thy "(%w. f x (y w) (z w)) == (f[#x,y,z])"
  13.211 -  (fn _ => [rtac inteq_reflection 1,
  13.212 -            rtac intI 1,
  13.213 -            rewrite_goals_tac intensional_rews,
  13.214 -            rtac refl 1
  13.215 -           ]);
  13.216 +    (* match tha with some premise of thb *)
  13.217 +    fun matchsome tha thb =
  13.218 +      let fun hmatch 0 = raise THM("matchsome: no match", 0, [tha,thb])
  13.219 +	    | hmatch n = (matchres tha n thb) handle _ => hmatch (n-1)
  13.220 +      in hmatch (nprems_of thb) end
  13.221  
  13.222 -qed_goal "lift3_abs_con2" Intensional.thy "(%w. f (x w) y (z w)) == (f[x,#y,z])"
  13.223 -  (fn _ => [rtac inteq_reflection 1,
  13.224 -            rtac intI 1,
  13.225 -            rewrite_goals_tac intensional_rews,
  13.226 -            rtac refl 1
  13.227 -           ]);
  13.228 -
  13.229 -qed_goal "lift3_abs_con3" Intensional.thy "(%w. f (x w) (y w) z) == (f[x,y,#z])"
  13.230 -  (fn _ => [rtac inteq_reflection 1,
  13.231 -            rtac intI 1,
  13.232 -            rewrite_goals_tac intensional_rews,
  13.233 -            rtac refl 1
  13.234 -           ]);
  13.235 +    fun hflatten t =
  13.236 +        case (concl_of t) of
  13.237 +          Const _ $ (Const ("op -->", _) $ _ $ _) => hflatten (t RS mp)
  13.238 +        | _ => (hflatten (matchsome conjI t)) handle _ => zero_var_indexes t
  13.239 +  in
  13.240 +    hflatten t
  13.241 +end;
  13.242  
  13.243 -qed_goal "lift3_abs_con12" Intensional.thy "(%w. f x y (z w)) == (f[#x,#y,z])"
  13.244 -  (fn _ => [rtac inteq_reflection 1,
  13.245 -            rtac intI 1,
  13.246 -            rewrite_goals_tac intensional_rews,
  13.247 -            rtac refl 1
  13.248 -           ]);
  13.249 +fun int_use th =
  13.250 +    case (concl_of th) of
  13.251 +      Const _ $ (Const ("Intensional.Valid", _) $ _) =>
  13.252 +              ((flatten (int_unlift th)) handle _ => th)
  13.253 +    | _ => th;
  13.254  
  13.255 -qed_goal "lift3_abs_con13" Intensional.thy "(%w. f x (y w) z) == (f[#x,y,#z])"
  13.256 -  (fn _ => [rtac inteq_reflection 1,
  13.257 -            rtac intI 1,
  13.258 -            rewrite_goals_tac intensional_rews,
  13.259 -            rtac refl 1
  13.260 -           ]);
  13.261 +(***
  13.262 +(* Make the simplifier accept "intensional" goals by either turning them into
  13.263 +   a meta-equality or by unlifting them.
  13.264 +*)
  13.265  
  13.266 -qed_goal "lift3_abs_con23" Intensional.thy "(%w. f (x w) y z) == (f[x,#y,#z])"
  13.267 -  (fn _ => [rtac inteq_reflection 1,
  13.268 -            rtac intI 1,
  13.269 -            rewrite_goals_tac intensional_rews,
  13.270 -            rtac refl 1
  13.271 -           ]);
  13.272 +let 
  13.273 +  val ss = simpset_ref()
  13.274 +  fun try_rewrite th = (int_rewrite th) handle _ => (int_use th) handle _ => th
  13.275 +in 
  13.276 +  ss := !ss setmksimps ((mksimps mksimps_pairs) o try_rewrite)
  13.277 +end;
  13.278 +***)
  13.279  
  13.280  (* ========================================================================= *)
  13.281  
  13.282 -qed_goal "Not_rall" Intensional.thy
  13.283 -   "(.~ (RALL x. F(x))) .= (REX x. .~ F(x))"
  13.284 -   (fn _ => [rtac intI 1,
  13.285 -	     rewrite_goals_tac intensional_rews,
  13.286 -	     fast_tac HOL_cs 1
  13.287 -	    ]);
  13.288 +qed_goal "Not_Rall" Intensional.thy
  13.289 +   "|- (~(! x. F x)) = (? x. ~F x)"
  13.290 +   (fn _ => [simp_tac (simpset() addsimps [Valid_def]) 1]);
  13.291  
  13.292 -qed_goal "Not_rex" Intensional.thy
  13.293 -   "(.~ (REX x. F(x))) .= (RALL x. .~ F(x))"
  13.294 -   (fn _ => [rtac intI 1,
  13.295 -	     rewrite_goals_tac intensional_rews,
  13.296 -	     fast_tac HOL_cs 1
  13.297 -	    ]);
  13.298 +qed_goal "Not_Rex" Intensional.thy
  13.299 +   "|- (~ (? x. F x)) = (! x. ~ F x)"
  13.300 +   (fn _ => [simp_tac (simpset() addsimps [Valid_def]) 1]);
  13.301  
  13.302  (* IntLemmas.ML contains a collection of further lemmas about "intensional" logic.
  13.303     These are not loaded by default because they are not required for the
    14.1 --- a/src/HOL/TLA/Intensional.thy	Mon Feb 08 13:02:42 1999 +0100
    14.2 +++ b/src/HOL/TLA/Intensional.thy	Mon Feb 08 13:02:56 1999 +0100
    14.3 @@ -1,7 +1,7 @@
    14.4  (* 
    14.5      File:	 TLA/Intensional.thy
    14.6      Author:      Stephan Merz
    14.7 -    Copyright:   1997 University of Munich
    14.8 +    Copyright:   1998 University of Munich
    14.9  
   14.10      Theory Name: Intensional
   14.11      Logic Image: HOL
   14.12 @@ -10,95 +10,168 @@
   14.13  on top of HOL, with lifting of constants and functions.
   14.14  *)
   14.15  
   14.16 -Intensional  =  Prod +
   14.17 +Intensional  =  Main +
   14.18  
   14.19 -classes
   14.20 -    world < logic    (* Type class of "possible worlds". Concrete types
   14.21 -                        will be provided by children theories. *)
   14.22 +axclass
   14.23 +  world < term
   14.24 +
   14.25 +(** abstract syntax **)
   14.26  
   14.27  types
   14.28 -    ('a,'w) term = "'w => 'a"    (* Intention: 'w::world *)
   14.29 -    'w form = "'w => bool"
   14.30 +  ('w,'a) expr = 'w => 'a               (* intention: 'w::world, 'a::term *)
   14.31 +  'w form = ('w, bool) expr
   14.32  
   14.33  consts
   14.34 -  TrueInt  :: "('w::world form) => prop"             ("(_)" 5)
   14.35 -
   14.36 -  (* Holds at *)
   14.37 -  holdsAt  :: "['w::world, 'w form] => bool"   ("(_ |= _)" [100,9] 8)
   14.38 -
   14.39 -  (* Lifting base functions to "intensional" level *)
   14.40 -  con      :: "'a => ('w::world => 'a)"               ("(#_)" [100] 99)
   14.41 -  lift     :: "['a => 'b, 'w::world => 'a] => ('w => 'b)"  ("(_[_])")
   14.42 -  lift2    :: "['a => ('b => 'c), 'w::world => 'a, 'w => 'b] => ('w => 'c)" ("(_[_,/ _])")
   14.43 -  lift3    :: "['a => 'b => 'c => 'd, 'w::world => 'a, 'w => 'b, 'w => 'c] => ('w => 'd)" ("(_[_,/ _,/ _])")
   14.44 +  Valid    :: ('w::world) form => bool
   14.45 +  const    :: 'a => ('w::world, 'a) expr
   14.46 +  lift     :: ['a => 'b, ('w::world, 'a) expr] => ('w,'b) expr
   14.47 +  lift2    :: ['a => 'b => 'c, ('w::world,'a) expr, ('w,'b) expr] => ('w,'c) expr
   14.48 +  lift3    :: ['a => 'b => 'c => 'd, ('w::world,'a) expr, ('w,'b) expr, ('w,'c) expr] => ('w,'d) expr
   14.49  
   14.50 -  (* Lifted infix functions *)
   14.51 -  IntEqu   :: "['w::world => 'a, 'w => 'a] => 'w form"  ("(_ .=/ _)" [50,51] 50)
   14.52 -  IntNeq   :: "['w::world => 'a, 'w => 'a] => 'w form"  ("(_ .~=/ _)" [50,51] 50)
   14.53 -  NotInt   :: "('w::world) form => 'w form"               ("(.~ _)" [40] 40)
   14.54 -  AndInt   :: "[('w::world) form, 'w form] => 'w form"    ("(_ .&/ _)" [36,35] 35)
   14.55 -  OrInt    :: "[('w::world) form, 'w form] => 'w form"    ("(_ .|/ _)" [31,30] 30)
   14.56 -  ImpInt   :: "[('w::world) form, 'w form] => 'w form"    ("(_ .->/ _)" [26,25] 25)
   14.57 -  IfInt    :: "[('w::world) form, ('a,'w) term, ('a,'w) term] => ('a,'w) term" ("(.if (_)/ .then (_)/ .else (_))" 10)
   14.58 -  PlusInt  :: "[('w::world) => ('a::plus), 'w => 'a] => ('w => 'a)"  ("(_ .+/ _)" [66,65] 65)
   14.59 -  MinusInt :: "[('w::world) => ('a::minus), 'w => 'a] => ('w => 'a)"  ("(_ .-/ _)" [66,65] 65)
   14.60 -  TimesInt :: "[('w::world) => ('a::times), 'w => 'a] => ('w => 'a)"  ("(_ .*/ _)" [71,70] 70)
   14.61 +  (* "Rigid" quantification (logic level) *)
   14.62 +  RAll     :: "('a => ('w::world) form) => 'w form"       (binder "Rall " 10)
   14.63 +  REx      :: "('a => ('w::world) form) => 'w form"       (binder "Rex " 10)
   14.64 +  REx1     :: "('a => ('w::world) form) => 'w form"       (binder "Rex! " 10)
   14.65  
   14.66 -  LessInt  :: "['w::world => 'a::ord, 'w => 'a] => 'w form"        ("(_/ .< _)"  [50, 51] 50)
   14.67 -  LeqInt   :: "['w::world => 'a::ord, 'w => 'a] => 'w form"        ("(_/ .<= _)" [50, 51] 50)
   14.68 +(** concrete syntax **)
   14.69  
   14.70 -  (* lifted set membership *)
   14.71 -  memInt   :: "[('a,'w::world) term, ('a set,'w) term] => 'w form"  ("(_/ .: _)" [50, 51] 50)
   14.72 -
   14.73 -  (* "Rigid" quantification *)
   14.74 -  RAll     :: "('a => 'w::world form) => 'w form"     (binder "RALL " 10)
   14.75 -  REx      :: "('a => 'w::world form) => 'w form"     (binder "REX " 10)
   14.76 +nonterminals
   14.77 +  lift
   14.78 +  liftargs
   14.79  
   14.80  syntax
   14.81 -  "@tupleInt"    :: "args => ('a * 'b, 'w) term"  ("(1{[_]})")
   14.82 +  ""            :: id => lift                          ("_")
   14.83 +  ""            :: longid => lift                      ("_")
   14.84 +  ""            :: var => lift                         ("_")
   14.85 +  "_applC"      :: [lift, cargs] => lift               ("(1_/ _)" [1000, 1000] 999)
   14.86 +  ""            :: lift => lift                        ("'(_')")
   14.87 +  "_lambda"     :: [idts, 'a] => lift                  ("(3%_./ _)" [0, 3] 3)
   14.88 +  "_constrain"  :: [lift, type] => lift                ("(_::_)" [4, 0] 3)
   14.89 +  ""            :: lift => liftargs                    ("_")
   14.90 +  "_liftargs"   :: [lift, liftargs] => liftargs        ("_,/ _")
   14.91 +  "_Valid"      :: lift => bool                        ("(|- _)" 5)
   14.92 +  "_holdsAt"    :: ['a, lift] => bool                  ("(_ |= _)" [100,10] 10)
   14.93 +
   14.94 +  (* Syntax for lifted expressions outside the scope of |- or |= *)
   14.95 +  "LIFT"        :: lift => 'a                          ("LIFT _")
   14.96 +
   14.97 +  (* generic syntax for lifted constants and functions *)
   14.98 +  "_const"      :: 'a => lift                          ("(#_)" [1000] 999)
   14.99 +  "_lift"       :: ['a, lift] => lift                  ("(_<_>)" [1000] 999)
  14.100 +  "_lift2"      :: ['a, lift, lift] => lift            ("(_<_,/ _>)" [1000] 999)
  14.101 +  "_lift3"      :: ['a, lift, lift, lift] => lift      ("(_<_,/ _,/ _>)" [1000] 999)
  14.102 +
  14.103 +  (* concrete syntax for common infix functions: reuse same symbol *)
  14.104 +  "_liftEqu"    :: [lift, lift] => lift                ("(_ =/ _)" [50,51] 50)
  14.105 +  "_liftNeq"    :: [lift, lift] => lift                ("(_ ~=/ _)" [50,51] 50)
  14.106 +  "_liftNot"    :: lift => lift                        ("(~ _)" [40] 40)
  14.107 +  "_liftAnd"    :: [lift, lift] => lift                ("(_ &/ _)" [36,35] 35)
  14.108 +  "_liftOr"     :: [lift, lift] => lift                ("(_ |/ _)" [31,30] 30)
  14.109 +  "_liftImp"    :: [lift, lift] => lift                ("(_ -->/ _)" [26,25] 25)
  14.110 +  "_liftIf"     :: [lift, lift, lift] => lift          ("(if (_)/ then (_)/ else (_))" 10)
  14.111 +  "_liftPlus"   :: [lift, lift] => lift                ("(_ +/ _)" [66,65] 65)
  14.112 +  "_liftMinus"  :: [lift, lift] => lift                ("(_ -/ _)" [66,65] 65)
  14.113 +  "_liftTimes"  :: [lift, lift] => lift                ("(_ */ _)" [71,70] 70)
  14.114 +  "_liftDiv"    :: [lift, lift] => lift                ("(_ div _)" [71,70] 70)
  14.115 +  "_liftMod"    :: [lift, lift] => lift                ("(_ mod _)" [71,70] 70)
  14.116 +  "_liftLess"   :: [lift, lift] => lift                ("(_/ < _)"  [50, 51] 50)
  14.117 +  "_liftLeq"    :: [lift, lift] => lift                ("(_/ <= _)" [50, 51] 50)
  14.118 +  "_liftMem"    :: [lift, lift] => lift                ("(_/ : _)" [50, 51] 50)
  14.119 +  "_liftNotMem" :: [lift, lift] => lift                ("(_/ ~: _)" [50, 51] 50)
  14.120 +  "_liftFinset" :: liftargs => lift                    ("{(_)}")
  14.121 +  (** TODO: syntax for lifted collection / comprehension **)
  14.122 +  "_liftPair"   :: [lift,liftargs] => lift                   ("(1'(_,/ _'))")
  14.123 +  (* infix syntax for list operations *)
  14.124 +  "_liftCons" :: [lift, lift] => lift                    ("(_ #/ _)" [65,66] 65)
  14.125 +  "_liftApp"  :: [lift, lift] => lift                    ("(_ @/ _)" [65,66] 65)
  14.126 +  "_liftList" :: liftargs => lift                        ("[(_)]")
  14.127 +
  14.128 +  (* Rigid quantification (syntax level) *)
  14.129 +  "_RAll"  :: [idts, lift] => lift                     ("(3! _./ _)" [0, 10] 10)
  14.130 +  "_REx"   :: [idts, lift] => lift                     ("(3? _./ _)" [0, 10] 10)
  14.131 +  "_REx1"  :: [idts, lift] => lift                     ("(3?! _./ _)" [0, 10] 10)
  14.132 +  "_ARAll" :: [idts, lift] => lift                     ("(3ALL _./ _)" [0, 10] 10)
  14.133 +  "_AREx"  :: [idts, lift] => lift                     ("(3EX _./ _)" [0, 10] 10)
  14.134 +  "_AREx1" :: [idts, lift] => lift                     ("(3EX! _./ _)" [0, 10] 10)
  14.135  
  14.136  translations
  14.137 +  "_const"        == "const"
  14.138 +  "_lift"         == "lift"
  14.139 +  "_lift2"        == "lift2"
  14.140 +  "_lift3"        == "lift3"
  14.141 +  "_Valid"        == "Valid"
  14.142 +  "_RAll x A"     == "Rall x. A"
  14.143 +  "_REx x  A"     == "Rex x. A"
  14.144 +  "_REx1 x  A"    == "Rex! x. A"
  14.145 +  "_ARAll"        => "_RAll"
  14.146 +  "_AREx"         => "_REx"
  14.147 +  "_AREx1"        => "_REx1"
  14.148  
  14.149 -  "{[x,y,z]}"   == "{[x, {[y,z]} ]}"
  14.150 -  "{[x,y]}"     == "Pair [x, y]"
  14.151 -  "{[x]}"       => "x"
  14.152 +  "w |= A"        => "A w"
  14.153 +  "LIFT A"        => "A::_=>_"
  14.154  
  14.155 -  "u .= v" == "op =[u,v]"
  14.156 -  "u .~= v" == ".~(u .= v)"
  14.157 -  ".~ A"   == "Not[A]"
  14.158 -  "A .& B" == "op &[A,B]"
  14.159 -  "A .| B"  == "op |[A,B]"
  14.160 -  "A .-> B" == "op -->[A,B]"
  14.161 -  ".if A .then u .else v" == "If[A,u,v]"
  14.162 -  "u .+ v"  == "op +[u,v]"
  14.163 -  "u .- v" == "op -[u,v]"
  14.164 -  "u .* v" == "op *[u,v]"
  14.165 +  "_liftEqu"      == "_lift2 (op =)"
  14.166 +  "_liftNeq u v"  == "_liftNot (_liftEqu u v)"
  14.167 +  "_liftNot"      == "_lift Not"
  14.168 +  "_liftAnd"      == "_lift2 (op &)"
  14.169 +  "_liftOr"       == "_lift2 (op | )"
  14.170 +  "_liftImp"      == "_lift2 (op -->)"
  14.171 +  "_liftIf"       == "_lift3 If"
  14.172 +  "_liftPlus"     == "_lift2 (op +)"
  14.173 +  "_liftMinus"    == "_lift2 (op -)"
  14.174 +  "_liftTimes"    == "_lift2 (op *)"
  14.175 +  "_liftDiv"      == "_lift2 (op div)"
  14.176 +  "_liftMod"      == "_lift2 (op mod)"
  14.177 +  "_liftLess"     == "_lift2 (op <)"
  14.178 +  "_liftLeq"      == "_lift2 (op <=)"
  14.179 +  "_liftMem"      == "_lift2 (op :)"
  14.180 +  "_liftNotMem x xs"   == "_liftNot (_liftMem x xs)"
  14.181 +  "_liftFinset (_liftargs x xs)"  == "_lift2 insert x (_liftFinset xs)"
  14.182 +  "_liftFinset x" == "_lift2 insert x (_const {})"
  14.183 +  "_liftPair x (_liftargs y z)"       == "_liftPair x (_liftPair y z)"
  14.184 +  "_liftPair"     == "_lift2 Pair"
  14.185 +  "_liftCons"     == "lift2 (op #)"
  14.186 +  "_liftApp"      == "lift2 (op @)"
  14.187 +  "_liftList (_liftargs x xs)"  == "_liftCons x (_liftList xs)"
  14.188 +  "_liftList x"   == "_liftCons x (_const [])"
  14.189  
  14.190 -  "a .< b"  == "op < [a,b]"
  14.191 -  "a .<= b" == "op <= [a,b]"
  14.192 -  "a .: A"  == "op :[a,A]"
  14.193 +  
  14.194  
  14.195 -  "holdsAt w (lift f x)"      == "lift f x w"
  14.196 -  "holdsAt w (lift2 f x y)"   == "lift2 f x y w"
  14.197 -  "holdsAt w (lift3 f x y z)" == "lift3 f x y z w"
  14.198 -
  14.199 -  "w |= A"              => "A(w)"
  14.200 +  "w |= ~A"       <= "_liftNot A w"
  14.201 +  "w |= A & B"    <= "_liftAnd A B w"
  14.202 +  "w |= A | B"    <= "_liftOr A B w"
  14.203 +  "w |= A --> B"  <= "_liftImp A B w"
  14.204 +  "w |= u = v"    <= "_liftEqu u v w"
  14.205 +  "w |= ! x. A"   <= "_RAll x A w"
  14.206 +  "w |= ? x. A"   <= "_REx x A w"
  14.207 +  "w |= ?! x. A"  <= "_REx1 x A w"
  14.208  
  14.209  syntax (symbols)
  14.210 -  holdsAt  :: "['w::world, 'w form] => bool"   ("(_ \\<Turnstile> _)" [100,9] 8)
  14.211 -
  14.212 +  "_Valid"      :: lift => bool                        ("(\\<turnstile> _)" 5)
  14.213 +  "_holdsAt"    :: ['a, lift] => bool                  ("(_ \\<Turnstile> _)" [100,10] 10)
  14.214 +  "_liftNeq"    :: [lift, lift] => lift                (infixl "\\<noteq>" 50)
  14.215 +  "_liftNot"    :: lift => lift                        ("\\<not> _" [40] 40)
  14.216 +  "_liftAnd"    :: [lift, lift] => lift                (infixr "\\<and>" 35)
  14.217 +  "_liftOr"     :: [lift, lift] => lift                (infixr "\\<or>" 30)
  14.218 +  "_liftImp"    :: [lift, lift] => lift                (infixr "\\<midarrow>\\<rightarrow>" 25)
  14.219 +  "_RAll"       :: [idts, lift] => lift                ("(3\\<forall>_./ _)" [0, 10] 10)
  14.220 +  "_REx"        :: [idts, lift] => lift                ("(3\\<exists>_./ _)" [0, 10] 10)
  14.221 +  "_REx1"       :: [idts, lift] => lift                ("(3\\<exists>!_./ _)" [0, 10] 10)
  14.222 +  "_liftLeq"    :: [lift, lift] => lift                ("(_/ \\<le> _)" [50, 51] 50)
  14.223 +  "_liftMem"    :: [lift, lift] => lift                ("(_/ \\<in> _)" [50, 51] 50)
  14.224 +  "_liftNotMem" :: [lift, lift] => lift                ("(_/ \\<notin> _)" [50, 51] 50)
  14.225  
  14.226  rules
  14.227 -  inteq_reflection   "(x .= y) ==> (x == y)"
  14.228 +  Valid_def   "|- A    ==  ALL w. w |= A"
  14.229  
  14.230 -  int_valid   "TrueInt(A) == (!! w. w |= A)"
  14.231 +  unl_con     "LIFT #c w  ==  c" 
  14.232 +  unl_lift    "LIFT f<x> w == f (x w)"
  14.233 +  unl_lift2   "LIFT f<x, y> w == f (x w) (y w)"
  14.234 +  unl_lift3   "LIFT f<x, y, z> w == f (x w) (y w) (z w)"
  14.235  
  14.236 -  unl_con     "(#c) w == c"             (* constants *)
  14.237 -  unl_lift    "(f[x]) w == f(x w)"
  14.238 -  unl_lift2   "(f[x,y]) w == f (x w) (y w)"
  14.239 -  unl_lift3   "(f[x, y, z]) w == f (x w) (y w) (z w)"
  14.240 +  unl_Rall    "w |= ! x. A x  ==  ! x. (w |= A x)" 
  14.241 +  unl_Rex     "w |= ? x. A x  ==  ? x. (w |= A x)"
  14.242 +  unl_Rex1    "w |= ?! x. A x  ==  ?! x. (w |= A x)"
  14.243 +end
  14.244  
  14.245 -  unl_Rall    "(RALL x. A(x)) w == ALL x. (w |= A(x))"
  14.246 -  unl_Rex     "(REX x. A(x)) w == EX x. (w |= A(x))"
  14.247 -
  14.248 -end
  14.249 +ML
    15.1 --- a/src/HOL/TLA/Memory/MIlive.ML	Mon Feb 08 13:02:42 1999 +0100
    15.2 +++ b/src/HOL/TLA/Memory/MIlive.ML	Mon Feb 08 13:02:56 1999 +0100
    15.3 @@ -14,10 +14,10 @@
    15.4  (* ------------------------------ State S1 ------------------------------ *)
    15.5  
    15.6  qed_goal "S1_successors" MemoryImplementation.thy
    15.7 -   "$(S1 rmhist p) .& ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>  \
    15.8 -\   .-> $(S1 rmhist p)` .| $(S2 rmhist p)`"
    15.9 +   "|- $S1 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)  \
   15.10 +\      --> (S1 rmhist p)` | (S2 rmhist p)`"
   15.11     (fn _ => [split_idle_tac [] 1,
   15.12 -	     auto_tac (MI_css addSEs2 [action_conjimpE Step1_2_1])
   15.13 +	     auto_tac (MI_css addSDs2 [Step1_2_1])
   15.14  	    ]);
   15.15  
   15.16  (* Show that the implementation can satisfy the high-level fairness requirements
   15.17 @@ -25,61 +25,61 @@
   15.18  *)
   15.19  
   15.20  qed_goal "S1_RNextdisabled" MemoryImplementation.thy
   15.21 -   "$(S1 rmhist p) .-> \
   15.22 -\   .~$(Enabled (<RNext memCh mem (resbar rmhist) p>_<rtrner memCh @ p, resbar rmhist @ p>))"
   15.23 +   "|- S1 rmhist p --> \
   15.24 +\      ~Enabled (<RNext memCh mm (resbar rmhist) p>_(rtrner memCh!p, resbar rmhist!p))"
   15.25     (fn _ => [action_simp_tac (simpset() addsimps [angle_def,S_def,S1_def])
   15.26 -	                     [notI] [enabledE,MemoryidleE] 1,
   15.27 -	     auto_tac MI_fast_css
   15.28 +	                     [notI] [enabledE,temp_elim Memoryidle] 1,
   15.29 +	     Force_tac 1
   15.30  	    ]);
   15.31  
   15.32  qed_goal "S1_Returndisabled" MemoryImplementation.thy
   15.33 -   "$(S1 rmhist p) .-> \
   15.34 -\   .~$(Enabled (<MemReturn memCh (resbar rmhist) p>_<rtrner memCh @ p, resbar rmhist @ p>))"
   15.35 +   "|- S1 rmhist p --> \
   15.36 +\      ~Enabled (<MemReturn memCh (resbar rmhist) p>_(rtrner memCh!p, resbar rmhist!p))"
   15.37     (fn _ => [action_simp_tac (simpset() addsimps [angle_def,MemReturn_def,Return_def,S_def,S1_def])
   15.38  	                     [notI] [enabledE] 1
   15.39  	    ]);
   15.40  
   15.41  qed_goal "RNext_fair" MemoryImplementation.thy
   15.42 -   "!!sigma. (sigma |= []<>($(S1 rmhist p)))   \
   15.43 -\     ==> (sigma |= WF(RNext memCh mem (resbar rmhist) p)_<rtrner memCh @ p, resbar rmhist @ p>)"
   15.44 -   (fn _ => [auto_tac (MI_css addsimps2 [temp_rewrite WF_alt]
   15.45 +   "|- []<>S1 rmhist p   \
   15.46 +\      --> WF(RNext memCh mm (resbar rmhist) p)_(rtrner memCh!p, resbar rmhist!p)"
   15.47 +   (fn _ => [auto_tac (MI_css addsimps2 [WF_alt]
   15.48  			      addSIs2 [S1_RNextdisabled] addSEs2 [STL4E,DmdImplE])
   15.49  	    ]);
   15.50  
   15.51  qed_goal "Return_fair" MemoryImplementation.thy
   15.52 -   "!!sigma. (sigma |= []<>($(S1 rmhist p)))   \
   15.53 -\     ==> (sigma |= WF(MemReturn memCh (resbar rmhist) p)_<rtrner memCh @ p, resbar rmhist @ p>)"
   15.54 -   (fn _ => [auto_tac (MI_css addsimps2 [temp_rewrite WF_alt]
   15.55 +   "|- []<>S1 rmhist p   \
   15.56 +\      --> WF(MemReturn memCh (resbar rmhist) p)_(rtrner memCh!p, resbar rmhist!p)"
   15.57 +   (fn _ => [auto_tac (MI_css addsimps2 [WF_alt]
   15.58  			      addSIs2 [S1_Returndisabled] addSEs2 [STL4E,DmdImplE])
   15.59  	    ]);
   15.60  
   15.61  (* ------------------------------ State S2 ------------------------------ *)
   15.62  
   15.63  qed_goal "S2_successors" MemoryImplementation.thy
   15.64 -   "$(S2 rmhist p) .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>)   \
   15.65 -\   .-> $(S2 rmhist p)` .| $(S3 rmhist p)`"
   15.66 +   "|- $S2 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)   \
   15.67 +\      --> (S2 rmhist p)` | (S3 rmhist p)`"
   15.68     (fn _ => [split_idle_tac [] 1,
   15.69 -	     auto_tac (MI_css addSEs2 [action_conjimpE Step1_2_2])
   15.70 +	     auto_tac (MI_css addSDs2 [Step1_2_2])
   15.71  	    ]);
   15.72  
   15.73  qed_goal "S2MClkFwd_successors" MemoryImplementation.thy
   15.74 -   "$(S2 rmhist p) .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>)    \
   15.75 -\                  .& <MClkFwd memCh crCh cst p>_(c p) \
   15.76 -\   .-> $(S3 rmhist p)`"
   15.77 -   (fn _ => [ auto_tac (MI_css addsimps2 [angle_def] addSEs2 [action_conjimpE Step1_2_2]) ]);
   15.78 +   "|- ($S2 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p))    \
   15.79 +\      & <MClkFwd memCh crCh cst p>_(c p) \
   15.80 +\      --> (S3 rmhist p)`"
   15.81 +   (fn _ => [ auto_tac (MI_css addsimps2 [angle_def] addSDs2 [Step1_2_2]) ]);
   15.82  
   15.83  qed_goal "S2MClkFwd_enabled" MemoryImplementation.thy
   15.84 -   "$(S2 rmhist p) .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>)   \
   15.85 -\   .-> $(Enabled (<MClkFwd memCh crCh cst p>_(c p)))"
   15.86 -   (fn _ => [cut_facts_tac [MI_base] 1,
   15.87 -	     auto_tac (MI_css addsimps2 [c_def,base_pair]
   15.88 -		              addSIs2 [MClkFwd_ch_enabled,action_mp MClkFwd_enabled]),
   15.89 -	     ALLGOALS (action_simp_tac (simpset() addsimps [S_def,S2_def]) [] [])
   15.90 +   "|- $S2 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)    \
   15.91 +\      --> $Enabled (<MClkFwd memCh crCh cst p>_(c p))"
   15.92 +   (fn _ => [auto_tac (MI_css addsimps2 [c_def] addSIs2 [MClkFwd_ch_enabled,MClkFwd_enabled]),
   15.93 +             cut_facts_tac [MI_base] 1,
   15.94 +             blast_tac (claset() addDs [base_pair]) 1,
   15.95 +             ALLGOALS (asm_full_simp_tac (simpset() addsimps [S_def,S2_def]))
   15.96  	    ]);
   15.97  
   15.98  qed_goal "S2_live" MemoryImplementation.thy
   15.99 -   "[](ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>) .& WF(MClkFwd memCh crCh cst p)_(c p) \
  15.100 -\   .-> ($(S2 rmhist p) ~> $(S3 rmhist p))"
  15.101 +   "|- [](ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)) & WF(MClkFwd memCh crCh cst p)_(c p) \
  15.102 +\      --> (S2 rmhist p ~> S3 rmhist p)"
  15.103     (fn _ => [REPEAT (resolve_tac [WF1,S2_successors,
  15.104  				  S2MClkFwd_successors,S2MClkFwd_enabled] 1)
  15.105  	    ]);
  15.106 @@ -88,185 +88,165 @@
  15.107  (* ------------------------------ State S3 ------------------------------ *)
  15.108  
  15.109  qed_goal "S3_successors" MemoryImplementation.thy
  15.110 -   "$(S3 rmhist p) .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>)   \
  15.111 -\   .-> $(S3 rmhist p)` .| ($(S4 rmhist p) .| $(S6 rmhist p))`"
  15.112 +   "|- $S3 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)   \
  15.113 +\      --> (S3 rmhist p)` | (S4 rmhist p | S6 rmhist p)`"
  15.114     (fn _ => [split_idle_tac [] 1,
  15.115 -	     auto_tac (MI_css addSEs2 [action_conjimpE Step1_2_3])
  15.116 +	     auto_tac (MI_css addSDs2 [Step1_2_3])
  15.117  	    ]);
  15.118  
  15.119  qed_goal "S3RPC_successors" MemoryImplementation.thy
  15.120 -   "$(S3 rmhist p) .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>)   \
  15.121 -\                  .& <RPCNext crCh rmCh rst p>_(r p) \
  15.122 -\   .-> ($(S4 rmhist p) .| $(S6 rmhist p))`"
  15.123 -   (fn _ => [ auto_tac (MI_css addsimps2 [angle_def] addSEs2 [action_conjimpE Step1_2_3]) ]);
  15.124 +   "|- ($S3 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p))   \
  15.125 +\      & <RPCNext crCh rmCh rst p>_(r p) \
  15.126 +\      --> (S4 rmhist p | S6 rmhist p)`"
  15.127 +   (fn _ => [ auto_tac (MI_css addsimps2 [angle_def] addSDs2 [Step1_2_3]) ]);
  15.128  
  15.129  qed_goal "S3RPC_enabled" MemoryImplementation.thy
  15.130 -   "$(S3 rmhist p) .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>)   \
  15.131 -\   .-> $(Enabled (<RPCNext crCh rmCh rst p>_(r p)))"
  15.132 -   (fn _ => [cut_facts_tac [MI_base] 1,
  15.133 -	     auto_tac (MI_css addsimps2 [r_def,base_pair]
  15.134 -		              addSIs2 [RPCFail_Next_enabled,action_mp RPCFail_enabled]),
  15.135 -	     ALLGOALS (action_simp_tac (simpset() addsimps [S_def,S3_def]) [] [])
  15.136 +   "|- $S3 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)   \
  15.137 +\      --> $Enabled (<RPCNext crCh rmCh rst p>_(r p))"
  15.138 +   (fn _ => [auto_tac (MI_css addsimps2 [r_def]
  15.139 +		              addSIs2 [RPCFail_Next_enabled,RPCFail_enabled]),
  15.140 +	     cut_facts_tac [MI_base] 1,
  15.141 +	     blast_tac (claset() addDs [base_pair]) 1,
  15.142 +             ALLGOALS (asm_full_simp_tac (simpset() addsimps [S_def,S3_def]))
  15.143  	    ]);
  15.144  
  15.145  qed_goal "S3_live" MemoryImplementation.thy
  15.146 -   "[](ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>)  \
  15.147 -\        .& WF(RPCNext crCh rmCh rst p)_(r p) \
  15.148 -\   .-> ($(S3 rmhist p) ~> ($(S4 rmhist p) .| $(S6 rmhist p)))"
  15.149 +   "|- [](ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)) & WF(RPCNext crCh rmCh rst p)_(r p) \
  15.150 +\   --> (S3 rmhist p ~> S4 rmhist p | S6 rmhist p)"
  15.151     (fn _ => [REPEAT (resolve_tac [WF1,S3_successors,S3RPC_successors,S3RPC_enabled] 1)]);
  15.152  
  15.153  (* ------------- State S4 -------------------------------------------------- *)
  15.154  
  15.155  qed_goal "S4_successors" MemoryImplementation.thy
  15.156 -   "$(S4 rmhist p) .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p> \
  15.157 -\                                .& (RALL l. $(MemInv mem l)))  \
  15.158 -\   .-> $(S4 rmhist p)` .| $(S5 rmhist p)`"
  15.159 +   "|- $S4 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) \
  15.160 +\                   & (!l. $MemInv mm l)  \
  15.161 +\      --> (S4 rmhist p)` | (S5 rmhist p)`"
  15.162     (fn _ => [split_idle_tac [] 1,
  15.163 -	     auto_tac (MI_css addSEs2 [action_conjimpE Step1_2_4])
  15.164 +	     auto_tac (MI_css addSDs2 [Step1_2_4])
  15.165  	    ]);
  15.166  
  15.167  (* ------------- State S4a: S4 /\ (ires p = NotAResult) ------------------------------ *)
  15.168  
  15.169  qed_goal "S4a_successors" MemoryImplementation.thy
  15.170 -   "($(S4 rmhist p) .& ($(ires@p) .= #NotAResult)) \
  15.171 -\                   .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p> \
  15.172 -\                                 .& (RALL l. $(MemInv mem l))) \
  15.173 -\   .-> ($(S4 rmhist p) .& ($(ires@p) .= #NotAResult))`  \
  15.174 -\       .| (($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) .| $(S5 rmhist p))`"
  15.175 +   "|- $(S4 rmhist p & ires!p = #NotAResult) \
  15.176 +\      & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) & (!l. $MemInv mm l) \
  15.177 +\      --> (S4 rmhist p & ires!p = #NotAResult)`  \
  15.178 +\        | ((S4 rmhist p & ires!p ~= #NotAResult) | S5 rmhist p)`"
  15.179     (fn _ => [split_idle_tac [m_def] 1,
  15.180 -	     auto_tac (MI_css addsimps2 [m_def] addSEs2 [action_conjimpE Step1_2_4])
  15.181 +	     auto_tac (MI_css addSDs2 [Step1_2_4])
  15.182  	    ]);
  15.183  
  15.184  qed_goal "S4aRNext_successors" MemoryImplementation.thy
  15.185 -   "($(S4 rmhist p) .& ($(ires@p) .= #NotAResult))  \
  15.186 -\   .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>   \
  15.187 -\                 .& (RALL l. $(MemInv mem l)))  \
  15.188 -\   .& <RNext rmCh mem ires p>_(m p) \
  15.189 -\   .-> (($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) .| $(S5 rmhist p))`"
  15.190 +   "|- ($(S4 rmhist p & ires!p = #NotAResult)  \
  15.191 +\       & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) & (!l. $MemInv mm l))  \
  15.192 +\      & <RNext rmCh mm ires p>_(m p) \
  15.193 +\      --> ((S4 rmhist p & ires!p ~= #NotAResult) | S5 rmhist p)`"
  15.194     (fn _ => [auto_tac (MI_css addsimps2 [angle_def]
  15.195 -		              addSEs2 [action_conjimpE Step1_2_4,
  15.196 -				       action_conjimpE ReadResult, action_impE WriteResult])
  15.197 +		              addSDs2 [Step1_2_4, ReadResult, WriteResult])
  15.198  	    ]);
  15.199  
  15.200  qed_goal "S4aRNext_enabled" MemoryImplementation.thy
  15.201 -   "($(S4 rmhist p) .& ($(ires@p) .= #NotAResult)) \
  15.202 -\   .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>   \
  15.203 -\                 .& (RALL l. $(MemInv mem l)))  \
  15.204 -\   .-> $(Enabled (<RNext rmCh mem ires p>_(m p)))"
  15.205 -   (fn _ => [auto_tac (MI_css addsimps2 [m_def] addSIs2 [action_mp RNext_enabled]),
  15.206 -	     ALLGOALS (cut_facts_tac [MI_base]),
  15.207 -	     auto_tac (MI_css addsimps2 [base_pair]),
  15.208 -	        (* it's faster to expand S4 only where necessary *)
  15.209 -	     action_simp_tac (simpset() addsimps [S_def,S4_def]) [] [] 1
  15.210 +   "|- $(S4 rmhist p & ires!p = #NotAResult) \
  15.211 +\      & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) & (!l. $MemInv mm l)  \
  15.212 +\   --> $Enabled (<RNext rmCh mm ires p>_(m p))"
  15.213 +   (fn _ => [auto_tac (MI_css addsimps2 [m_def] addSIs2 [RNext_enabled]),
  15.214 +	     cut_facts_tac [MI_base] 1,
  15.215 +	     blast_tac (claset() addDs [base_pair]) 1,
  15.216 +	     asm_full_simp_tac (simpset() addsimps [S_def,S4_def]) 1
  15.217  	    ]);
  15.218  
  15.219  qed_goal "S4a_live" MemoryImplementation.thy
  15.220 -  "[](ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p> .& (RALL l. $(MemInv mem l))) \
  15.221 -\  .& WF(RNext rmCh mem ires p)_(m p) \
  15.222 -\  .-> (($(S4 rmhist p) .& ($(ires@p) .= #NotAResult))  \
  15.223 -\        ~> ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) .| $(S5 rmhist p))"
  15.224 -   (fn _ => [rtac WF1 1,
  15.225 -	     ALLGOALS (action_simp_tac (simpset())
  15.226 -		                       (map ((rewrite_rule [slice_def]) o action_mp) 
  15.227 -                                            [S4a_successors,S4aRNext_successors,S4aRNext_enabled])
  15.228 -				       [])
  15.229 -	    ]);
  15.230 +  "|- [](ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) & (!l. $MemInv mm l)) \
  15.231 +\     & WF(RNext rmCh mm ires p)_(m p) \
  15.232 +\     --> (S4 rmhist p & ires!p = #NotAResult  \
  15.233 +\          ~> (S4 rmhist p & ires!p ~= #NotAResult) | S5 rmhist p)"
  15.234 +   (K [REPEAT (resolve_tac [WF1, S4a_successors, S4aRNext_successors, S4aRNext_enabled] 1)]);
  15.235  
  15.236  (* ------------- State S4b: S4 /\ (ires p # NotAResult) ------------------------------ *)
  15.237  
  15.238  qed_goal "S4b_successors" MemoryImplementation.thy
  15.239 -   "($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult))  \
  15.240 -\                   .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p> \
  15.241 -\                                 .& (RALL l. $(MemInv mem l))) \
  15.242 -\   .-> ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult))` .| $(S5 rmhist p)`"
  15.243 +   "|- $(S4 rmhist p & ires!p ~= #NotAResult)  \
  15.244 +\      & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) & (!l. $MemInv mm l) \
  15.245 +\      --> (S4 rmhist p & ires!p ~= #NotAResult)` | (S5 rmhist p)`"
  15.246     (fn _ => [split_idle_tac [m_def] 1,
  15.247 -	     auto_tac (MI_css addSEs2 (action_impE WriteResult
  15.248 -				       :: map action_conjimpE [Step1_2_4,ReadResult]))
  15.249 +	     auto_tac (MI_css addSDs2 [WriteResult,Step1_2_4,ReadResult])
  15.250  	    ]);
  15.251  
  15.252  qed_goal "S4bReturn_successors" MemoryImplementation.thy
  15.253 -   "($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult))  \
  15.254 -\   .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p> \
  15.255 -\                 .& (RALL l. $(MemInv mem l)))   \
  15.256 -\   .& <MemReturn rmCh ires p>_(m p) \
  15.257 -\   .-> ($(S5 rmhist p))`"
  15.258 -   (fn _ => [auto_tac (MI_css addsimps2 [angle_def]
  15.259 -	                      addSEs2 [action_conjimpE Step1_2_4]
  15.260 -		              addEs2 [action_conjimpE ReturnNotReadWrite])
  15.261 +   "|- ($(S4 rmhist p & ires!p ~= #NotAResult)  \
  15.262 +\       & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) & (!l. $MemInv mm l))   \
  15.263 +\      & <MemReturn rmCh ires p>_(m p) \
  15.264 +\      --> (S5 rmhist p)`"
  15.265 +   (fn _ => [force_tac (MI_css addsimps2 [angle_def] addSDs2 [Step1_2_4]
  15.266 +                               addDs2 [ReturnNotReadWrite]) 1
  15.267  	    ]);
  15.268  
  15.269  qed_goal "S4bReturn_enabled" MemoryImplementation.thy
  15.270 -   "($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult))  \
  15.271 -\   .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p> \
  15.272 -\                 .& (RALL l. $(MemInv mem l)))  \
  15.273 -\   .-> $(Enabled (<MemReturn rmCh ires p>_(m p)))"
  15.274 -   (fn _ => [cut_facts_tac [MI_base] 1,
  15.275 -             auto_tac (MI_css addsimps2 [m_def,base_pair]
  15.276 -		              addSIs2 [action_mp MemReturn_enabled]),
  15.277 -	     ALLGOALS (action_simp_tac (simpset() addsimps [S_def,S4_def]) [] [])
  15.278 +   "|- $(S4 rmhist p & ires!p ~= #NotAResult)  \
  15.279 +\      & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) & (!l. $MemInv mm l)  \
  15.280 +\      --> $Enabled (<MemReturn rmCh ires p>_(m p))"
  15.281 +   (fn _ => [auto_tac (MI_css addsimps2 [m_def] addSIs2 [MemReturn_enabled]),
  15.282 +	     cut_facts_tac [MI_base] 1,
  15.283 +             blast_tac (claset() addDs [base_pair]) 1,
  15.284 +	     asm_full_simp_tac (simpset() addsimps [S_def,S4_def]) 1
  15.285  	    ]);
  15.286  
  15.287  qed_goal "S4b_live" MemoryImplementation.thy
  15.288 -  "[](ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p> .& (RALL l. $(MemInv mem l))) \
  15.289 -\  .& WF(MemReturn rmCh ires p)_(m p) \
  15.290 -\  .-> (($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) ~> $(S5 rmhist p))"
  15.291 -   (fn _ => [rtac WF1 1,
  15.292 -	     ALLGOALS (action_simp_tac (simpset())
  15.293 -		                       (map ((rewrite_rule [slice_def]) o action_mp) 
  15.294 -                                            [S4b_successors,S4bReturn_successors,S4bReturn_enabled])
  15.295 -				       [allE])
  15.296 -	    ]);
  15.297 +  "|- [](ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) & (!l. $MemInv mm l)) \
  15.298 +\     & WF(MemReturn rmCh ires p)_(m p) \
  15.299 +\     --> (S4 rmhist p & ires!p ~= #NotAResult ~> S5 rmhist p)"
  15.300 +   (K [REPEAT (resolve_tac [WF1, S4b_successors,S4bReturn_successors, S4bReturn_enabled] 1)]);
  15.301  
  15.302  (* ------------------------------ State S5 ------------------------------ *)
  15.303  
  15.304  qed_goal "S5_successors" MemoryImplementation.thy
  15.305 -   "$(S5 rmhist p) .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>) \
  15.306 -\   .-> $(S5 rmhist p)` .| $(S6 rmhist p)`"
  15.307 +   "|- $S5 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) \
  15.308 +\      --> (S5 rmhist p)` | (S6 rmhist p)`"
  15.309     (fn _ => [split_idle_tac [] 1,
  15.310 -	     auto_tac (MI_css addSEs2 [action_conjimpE Step1_2_5])
  15.311 +	     auto_tac (MI_css addSDs2 [Step1_2_5])
  15.312  	    ]);
  15.313  
  15.314  qed_goal "S5RPC_successors" MemoryImplementation.thy
  15.315 -   "$(S5 rmhist p) .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>) \
  15.316 -\   .& <RPCNext crCh rmCh rst p>_(r p) \
  15.317 -\   .-> $(S6 rmhist p)`"
  15.318 -   (fn _ => [ auto_tac (MI_css addsimps2 [angle_def] addSEs2 [action_conjimpE Step1_2_5]) ]);
  15.319 +   "|- ($S5 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)) \
  15.320 +\     & <RPCNext crCh rmCh rst p>_(r p) \
  15.321 +\     --> (S6 rmhist p)`"
  15.322 +   (fn _ => [ auto_tac (MI_css addsimps2 [angle_def] addSDs2 [Step1_2_5]) ]);
  15.323  
  15.324  qed_goal "S5RPC_enabled" MemoryImplementation.thy
  15.325 -   "$(S5 rmhist p) .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>) \
  15.326 -\   .-> $(Enabled (<RPCNext crCh rmCh rst p>_(r p)))"
  15.327 -   (fn _ => [cut_facts_tac [MI_base] 1,
  15.328 -	     auto_tac (MI_css addsimps2 [r_def,base_pair]
  15.329 -		              addSIs2 [RPCFail_Next_enabled,action_mp RPCFail_enabled]),
  15.330 -	     ALLGOALS (action_simp_tac (simpset() addsimps [S_def,S5_def]) [] [])
  15.331 +   "|- $S5 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) \
  15.332 +\      --> $Enabled (<RPCNext crCh rmCh rst p>_(r p))"
  15.333 +   (fn _ => [auto_tac (MI_css addsimps2 [r_def]
  15.334 +		              addSIs2 [RPCFail_Next_enabled, RPCFail_enabled]),
  15.335 +	     cut_facts_tac [MI_base] 1,
  15.336 +	     blast_tac (claset() addDs [base_pair]) 1,
  15.337 +	     ALLGOALS (asm_full_simp_tac (simpset() addsimps [S_def,S5_def]))
  15.338  	    ]);
  15.339  
  15.340  qed_goal "S5_live" MemoryImplementation.thy
  15.341 -   "[](ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>)   \
  15.342 -\   .& WF(RPCNext crCh rmCh rst p)_(r p) \
  15.343 -\   .-> ($(S5 rmhist p) ~> $(S6 rmhist p))"
  15.344 +   "|- [](ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p))   \
  15.345 +\      & WF(RPCNext crCh rmCh rst p)_(r p) \
  15.346 +\      --> (S5 rmhist p ~> S6 rmhist p)"
  15.347     (fn _ => [REPEAT (resolve_tac [WF1,S5_successors,S5RPC_successors,S5RPC_enabled] 1)]);
  15.348  
  15.349  
  15.350  (* ------------------------------ State S6 ------------------------------ *)
  15.351  
  15.352  qed_goal "S6_successors" MemoryImplementation.thy
  15.353 -   "$(S6 rmhist p) .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>) \
  15.354 -\   .-> $(S1 rmhist p)` .| $(S3 rmhist p)` .| $(S6 rmhist p)`"
  15.355 +   "|- $S6 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) \
  15.356 +\      --> (S1 rmhist p)` | (S3 rmhist p)` | (S6 rmhist p)`"
  15.357     (fn _ => [split_idle_tac [] 1,
  15.358 -	     auto_tac (MI_css addSEs2 [action_conjimpE Step1_2_6])
  15.359 +	     auto_tac (MI_css addSDs2 [Step1_2_6])
  15.360  	    ]);
  15.361  
  15.362  qed_goal "S6MClkReply_successors" MemoryImplementation.thy
  15.363 -   "$(S6 rmhist p) .& (ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>) \
  15.364 -\   .& <MClkReply memCh crCh cst p>_(c p) \
  15.365 -\   .-> $(S1 rmhist p)`"
  15.366 -   (fn _ => [auto_tac (MI_css addsimps2 [angle_def] addSEs2 [action_conjimpE Step1_2_6,
  15.367 -							     action_impE MClkReplyNotRetry])
  15.368 +   "|- ($S6 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)) \
  15.369 +\      & <MClkReply memCh crCh cst p>_(c p) \
  15.370 +\      --> (S1 rmhist p)`"
  15.371 +   (fn _ => [auto_tac (MI_css addsimps2 [angle_def] addSDs2 [Step1_2_6, MClkReplyNotRetry])
  15.372  	    ]);
  15.373  
  15.374  qed_goal "MClkReplyS6" MemoryImplementation.thy
  15.375 -   "$(ImpInv rmhist p) .& <MClkReply memCh crCh cst p>_(c p) .-> $(S6 rmhist p)"
  15.376 +   "|- $ImpInv rmhist p & <MClkReply memCh crCh cst p>_(c p) --> $S6 rmhist p"
  15.377     (fn _ => [action_simp_tac
  15.378  	        (simpset() addsimps
  15.379  		    [angle_def,MClkReply_def,Return_def,
  15.380 @@ -275,108 +255,111 @@
  15.381  	    ]);
  15.382  
  15.383  qed_goal "S6MClkReply_enabled" MemoryImplementation.thy
  15.384 -   "$(S6 rmhist p) .-> $(Enabled (<MClkReply memCh crCh cst p>_(c p)))"
  15.385 -   (fn _ => [cut_facts_tac [MI_base] 1,
  15.386 -	     auto_tac (MI_css addsimps2 [c_def,base_pair]
  15.387 -		              addSIs2 [action_mp MClkReply_enabled]),
  15.388 +   "|- S6 rmhist p --> Enabled (<MClkReply memCh crCh cst p>_(c p))"
  15.389 +   (fn _ => [auto_tac (MI_css addsimps2 [c_def] addSIs2 [MClkReply_enabled]),
  15.390 +	     cut_facts_tac [MI_base] 1,
  15.391 +	     blast_tac (claset() addDs [base_pair]) 1,
  15.392  	     ALLGOALS (action_simp_tac (simpset() addsimps [S_def,S6_def]) [] [])
  15.393  	    ]);
  15.394  
  15.395  qed_goal "S6_live" MemoryImplementation.thy
  15.396 -   "[](ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p> .& $(ImpInv rmhist p)) \
  15.397 -\   .& SF(MClkReply memCh crCh cst p)_(c p) .& []<>($(S6 rmhist p))  \
  15.398 -\   .-> []<>($(S1 rmhist p))"
  15.399 -   (fn _ => [Auto_tac,
  15.400 +   "|- [](ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p) & $(ImpInv rmhist p)) \
  15.401 +\      & SF(MClkReply memCh crCh cst p)_(c p) & []<>(S6 rmhist p)  \
  15.402 +\      --> []<>(S1 rmhist p)"
  15.403 +   (fn _ => [Clarsimp_tac 1,
  15.404  	     subgoal_tac "sigma |= []<>(<MClkReply memCh crCh cst p>_(c p))" 1,
  15.405 -	     eres_inst_tac [("P","<MClkReply memCh crCh cst p>_(c p)")]
  15.406 -	                   EnsuresInfinite 1, atac 1,
  15.407 +             etac InfiniteEnsures 1, atac 1,
  15.408  	     action_simp_tac (simpset()) []
  15.409 -	                     (map action_conjimpE [MClkReplyS6,S6MClkReply_successors]) 1,
  15.410 +	                     (map temp_elim [MClkReplyS6,S6MClkReply_successors]) 1,
  15.411  	     auto_tac (MI_css addsimps2 [SF_def]),
  15.412  	     etac swap 1,
  15.413 -	     auto_tac (MI_css addSIs2 [action_mp S6MClkReply_enabled]
  15.414 -		              addSEs2 [STL4E,DmdImplE])
  15.415 +	     auto_tac (MI_css addSIs2 [S6MClkReply_enabled] addSEs2 [STL4E, DmdImplE])
  15.416  	    ]);
  15.417  
  15.418  (* ------------------------------ complex leadsto properties ------------------------------ *)
  15.419  
  15.420  qed_goal "S5S6LeadstoS6" MemoryImplementation.thy
  15.421 -   "!!sigma. (sigma |= $(S5 rmhist p) ~> $(S6 rmhist p)) \
  15.422 -\      ==> (sigma |= ($(S5 rmhist p) .| $(S6 rmhist p)) ~> $(S6 rmhist p))"
  15.423 -   (fn _ => [auto_tac (MI_css addSIs2 [LatticeDisjunctionIntro,
  15.424 -				       temp_unlift LatticeReflexivity])
  15.425 +   "!!sigma. sigma |= S5 rmhist p ~> S6 rmhist p \
  15.426 +\      ==> sigma |= (S5 rmhist p | S6 rmhist p) ~> S6 rmhist p"
  15.427 +   (fn _ => [auto_tac (MI_css addSIs2 [LatticeDisjunctionIntro, LatticeReflexivity])
  15.428  	    ]);
  15.429  
  15.430  qed_goal "S4bS5S6LeadstoS6" MemoryImplementation.thy
  15.431 -   "!!sigma. [| (sigma |= ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) ~> $(S5 rmhist p));  \
  15.432 -\               (sigma |= $(S5 rmhist p) ~> $(S6 rmhist p)) |]  \
  15.433 -\      ==> (sigma |= (($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) .| $(S5 rmhist p) .| $(S6 rmhist p)) ~> $(S6 rmhist p))"
  15.434 +   "!!sigma. [| sigma |= S4 rmhist p & ires!p ~= #NotAResult ~> S5 rmhist p;  \
  15.435 +\               sigma |= S5 rmhist p ~> S6 rmhist p |]  \
  15.436 +\      ==> sigma |= (S4 rmhist p & ires!p ~= #NotAResult) | S5 rmhist p | S6 rmhist p \
  15.437 +\                   ~> S6 rmhist p"
  15.438     (fn _ => [auto_tac (MI_css addSIs2 [LatticeDisjunctionIntro,S5S6LeadstoS6]
  15.439  		              addIs2 [LatticeTransitivity])
  15.440              ]);
  15.441  
  15.442  qed_goal "S4S5S6LeadstoS6" MemoryImplementation.thy
  15.443 -   "!!sigma. [| (sigma |= ($(S4 rmhist p) .& ($(ires@p) .= #NotAResult)) \
  15.444 -\                             ~> ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) .| $(S5 rmhist p)); \
  15.445 -\               (sigma |= ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) ~> $(S5 rmhist p));  \
  15.446 -\               (sigma |= $(S5 rmhist p) ~> $(S6 rmhist p)) |]  \
  15.447 -\      ==> (sigma |= ($(S4 rmhist p) .| $(S5 rmhist p) .| $(S6 rmhist p)) ~> $(S6 rmhist p))"
  15.448 -   (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,
  15.449 -	     eres_inst_tac [("G", "($(S4 rmhist p) .& ($(ires@p) .= #NotAResult)) .| ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) .| $(S5 rmhist p) .| $(S6 rmhist p)")] LatticeTransitivity 1,
  15.450 -	     SELECT_GOAL (auto_tac (MI_css addSIs2 [ImplLeadsto, temp_unlift necT])) 1,
  15.451 -	     rtac LatticeDisjunctionIntro 1,
  15.452 -	     etac LatticeTransitivity 1,
  15.453 -	     etac LatticeTriangle 1, atac 1,
  15.454 +   "!!sigma. [| sigma |= S4 rmhist p & ires!p = #NotAResult \
  15.455 +\                        ~> (S4 rmhist p & ires!p ~= #NotAResult) | S5 rmhist p; \
  15.456 +\               sigma |= S4 rmhist p & ires!p ~= #NotAResult ~> S5 rmhist p;  \
  15.457 +\               sigma |= S5 rmhist p ~> S6 rmhist p |]  \
  15.458 +\      ==> sigma |= S4 rmhist p | S5 rmhist p | S6 rmhist p ~> S6 rmhist p"
  15.459 +   (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,
  15.460 +	     eres_inst_tac [("G", "PRED ((S4 rmhist p & ires!p = #NotAResult) | (S4 rmhist p & ires!p ~= #NotAResult) | S5 rmhist p | S6 rmhist p)")] (temp_use LatticeTransitivity) 1,
  15.461 +	     force_tac (MI_css addsimps2 Init_defs addSIs2 [ImplLeadsto_gen, necT]) 1,
  15.462 +	     rtac (temp_use LatticeDisjunctionIntro) 1,
  15.463 +	     etac (temp_use LatticeTransitivity) 1,
  15.464 +	     etac (temp_use LatticeTriangle2) 1, atac 1,
  15.465  	     auto_tac (MI_css addSIs2 [S4bS5S6LeadstoS6])
  15.466  	    ]);
  15.467  
  15.468  qed_goal "S3S4S5S6LeadstoS6" MemoryImplementation.thy
  15.469 -   "!!sigma. [| (sigma |= $(S3 rmhist p) ~> ($(S4 rmhist p) .| $(S6 rmhist p)));   \
  15.470 -\               (sigma |= ($(S4 rmhist p) .& ($(ires@p) .= #NotAResult)) \
  15.471 -\                         ~> ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) .| $(S5 rmhist p)); \
  15.472 -\               (sigma |= ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) ~> $(S5 rmhist p));  \
  15.473 -\               (sigma |= $(S5 rmhist p) ~> $(S6 rmhist p)) |]  \
  15.474 -\      ==> (sigma |= ($(S3 rmhist p) .| $(S4 rmhist p) .| $(S5 rmhist p) .| $(S6 rmhist p)) ~> $(S6 rmhist p))"
  15.475 -   (fn _ => [rtac LatticeDisjunctionIntro 1,
  15.476 -	     rtac LatticeTriangle 1, atac 2,
  15.477 -	     rtac (S4S5S6LeadstoS6 RS LatticeTransitivity) 1,
  15.478 -	     auto_tac (MI_css addSIs2 [S4S5S6LeadstoS6,temp_unlift necT]
  15.479 -			      addIs2 [ImplLeadsto])
  15.480 +   "!!sigma. [| sigma |= S3 rmhist p ~> S4 rmhist p | S6 rmhist p;   \
  15.481 +\               sigma |= S4 rmhist p & ires!p = #NotAResult \
  15.482 +\                         ~> (S4 rmhist p & ires!p ~= #NotAResult) | S5 rmhist p; \
  15.483 +\               sigma |= S4 rmhist p & ires!p ~= #NotAResult ~> S5 rmhist p;  \
  15.484 +\               sigma |= S5 rmhist p ~> S6 rmhist p |]  \
  15.485 +\      ==> sigma |= S3 rmhist p | S4 rmhist p | S5 rmhist p | S6 rmhist p ~> S6 rmhist p"
  15.486 +   (fn _ => [rtac (temp_use LatticeDisjunctionIntro) 1,
  15.487 +	     etac (temp_use LatticeTriangle2) 1,
  15.488 +	     rtac (S4S5S6LeadstoS6 RS (temp_use LatticeTransitivity)) 1,
  15.489 +	     auto_tac (MI_css addSIs2 [S4S5S6LeadstoS6,necT]
  15.490 +			      addIs2 [ImplLeadsto_gen] addsimps2 Init_defs)
  15.491  	    ]);
  15.492  
  15.493  qed_goal "S2S3S4S5S6LeadstoS6" MemoryImplementation.thy
  15.494 -   "!!sigma. [| (sigma |= $(S2 rmhist p) ~> $(S3 rmhist p)); \
  15.495 -\               (sigma |= $(S3 rmhist p) ~> ($(S4 rmhist p) .| $(S6 rmhist p)));   \
  15.496 -\               (sigma |= ($(S4 rmhist p) .& ($(ires@p) .= #NotAResult)) \
  15.497 -\                         ~> ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) .| $(S5 rmhist p)); \
  15.498 -\               (sigma |= ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) ~> $(S5 rmhist p));  \
  15.499 -\               (sigma |= $(S5 rmhist p) ~> $(S6 rmhist p)) |]  \
  15.500 -\      ==> (sigma |= ($(S2 rmhist p) .| $(S3 rmhist p) .| $(S4 rmhist p) .| $(S5 rmhist p) .| $(S6 rmhist p)) ~> $(S6 rmhist p))"
  15.501 -   (fn _ => [rtac LatticeDisjunctionIntro 1,
  15.502 -	     rtac LatticeTransitivity 1, atac 2,
  15.503 -	     rtac (S3S4S5S6LeadstoS6 RS LatticeTransitivity) 1,
  15.504 -	     auto_tac (MI_css addSIs2 [S3S4S5S6LeadstoS6,temp_unlift necT]
  15.505 -			      addIs2 [ImplLeadsto])
  15.506 +   "!!sigma. [| sigma |= S2 rmhist p ~> S3 rmhist p; \
  15.507 +\               sigma |= S3 rmhist p ~> S4 rmhist p | S6 rmhist p;   \
  15.508 +\               sigma |= S4 rmhist p & ires!p = #NotAResult \
  15.509 +\                         ~> S4 rmhist p & ires!p ~= #NotAResult | S5 rmhist p; \
  15.510 +\               sigma |= S4 rmhist p & ires!p ~= #NotAResult ~> S5 rmhist p;  \
  15.511 +\               sigma |= S5 rmhist p ~> S6 rmhist p |]  \
  15.512 +\      ==> sigma |= S2 rmhist p | S3 rmhist p | S4 rmhist p | S5 rmhist p | S6 rmhist p \
  15.513 +\                   ~> S6 rmhist p"
  15.514 +   (fn _ => [rtac (temp_use LatticeDisjunctionIntro) 1,
  15.515 +	     rtac (temp_use LatticeTransitivity) 1, atac 2,
  15.516 +	     rtac (S3S4S5S6LeadstoS6 RS (temp_use LatticeTransitivity)) 1,
  15.517 +	     auto_tac (MI_css addSIs2 [S3S4S5S6LeadstoS6,necT]
  15.518 +			      addIs2 [ImplLeadsto_gen] addsimps2 Init_defs)
  15.519  	    ]);
  15.520  
  15.521  qed_goal "NotS1LeadstoS6" MemoryImplementation.thy
  15.522 -   "!!sigma. [| (sigma |= []($(ImpInv rmhist p))); \
  15.523 -\        (sigma |= $(S2 rmhist p) ~> $(S3 rmhist p)); \
  15.524 -\        (sigma |= $(S3 rmhist p) ~> ($(S4 rmhist p) .| $(S6 rmhist p))); \
  15.525 -\        (sigma |= ($(S4 rmhist p) .& ($(ires@p) .= #NotAResult)) \
  15.526 -\                  ~> ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) .| $(S5 rmhist p)); \
  15.527 -\        (sigma |= ($(S4 rmhist p) .& ($(ires@p) .~= #NotAResult)) ~> $(S5 rmhist p));  \
  15.528 -\        (sigma |= $(S5 rmhist p) ~> $(S6 rmhist p)) |] \
  15.529 -\        ==> (sigma |= .~$(S1 rmhist p) ~> $(S6 rmhist p))"
  15.530 -   (fn _ => [rtac (S2S3S4S5S6LeadstoS6 RS LatticeTransitivity) 1,
  15.531 -	     auto_tac (MI_css addsimps2 [ImpInv_def] addIs2 [ImplLeadsto] addSEs2 [STL4E])
  15.532 +   "!!sigma. [| sigma |= []ImpInv rmhist p; \
  15.533 +\        sigma |= S2 rmhist p ~> S3 rmhist p; \
  15.534 +\        sigma |= S3 rmhist p ~> S4 rmhist p | S6 rmhist p; \
  15.535 +\        sigma |= S4 rmhist p & ires!p = #NotAResult \
  15.536 +\                 ~> S4 rmhist p & ires!p ~= #NotAResult | S5 rmhist p; \
  15.537 +\        sigma |= S4 rmhist p & ires!p ~= #NotAResult ~> S5 rmhist p;  \
  15.538 +\        sigma |= S5 rmhist p ~> S6 rmhist p |] \
  15.539 +\        ==> sigma |= ~S1 rmhist p ~> S6 rmhist p"
  15.540 +   (fn _ => [rtac (S2S3S4S5S6LeadstoS6 RS (temp_use LatticeTransitivity)) 1,
  15.541 +             TRYALL atac,
  15.542 +             etac (temp_use INV_leadsto) 1,
  15.543 +             rtac (temp_use ImplLeadsto_gen) 1,
  15.544 +             rtac (temp_use necT) 1,
  15.545 +	     auto_tac (MI_css addsimps2 ImpInv_def::Init_defs addSIs2 [necT])
  15.546  	    ]);
  15.547  
  15.548  qed_goal "S1Infinite" MemoryImplementation.thy
  15.549 -   "!!sigma. [| (sigma |= .~$(S1 rmhist p) ~> $(S6 rmhist p)); \
  15.550 -\               (sigma |= []<>($(S6 rmhist p)) .-> []<>($(S1 rmhist p))) |] \
  15.551 -\            ==> (sigma |= []<>($(S1 rmhist p)))"
  15.552 +   "!!sigma. [| sigma |= ~S1 rmhist p ~> S6 rmhist p; \
  15.553 +\               sigma |= []<>S6 rmhist p --> []<>S1 rmhist p |] \
  15.554 +\            ==> sigma |= []<>S1 rmhist p"
  15.555     (fn _ => [rtac classical 1,
  15.556 -	     asm_full_simp_tac (simpset() addsimps [NotBox, temp_rewrite NotDmd]) 1,
  15.557 -	     auto_tac (MI_css addSEs2 [mp,leadsto_infinite] addSDs2 [temp_mp DBImplBDAct])
  15.558 +	     asm_full_simp_tac (simpset() addsimps [temp_use NotBox, NotDmd]) 1,
  15.559 +	     auto_tac (MI_css addSEs2 [mp,leadsto_infinite] addSDs2 [DBImplBD])
  15.560  	    ]);
    16.1 --- a/src/HOL/TLA/Memory/MIsafe.ML	Mon Feb 08 13:02:42 1999 +0100
    16.2 +++ b/src/HOL/TLA/Memory/MIsafe.ML	Mon Feb 08 13:02:56 1999 +0100
    16.3 @@ -10,19 +10,15 @@
    16.4  
    16.5  (* RPCFailure notin MemVals U {OK,BadArg} *)
    16.6  
    16.7 -qed_goal "MVOKBAnotRF" MemoryImplementation.thy
    16.8 +qed_goalw "MVOKBAnotRF" MemoryImplementation.thy [MVOKBA_def]
    16.9     "!!x. MVOKBA x ==> x ~= RPCFailure"
   16.10 -   (fn _ => [ auto_tac (HOL_css addsimps2 (RP_simps @ [MVOKBA_def])) ]);
   16.11 -bind_thm("MVOKBAnotRFE", make_elim MVOKBAnotRF);
   16.12 +   (fn _ => [ Auto_tac ]);
   16.13  
   16.14  (* NotAResult notin MemVals U {OK,BadArg,RPCFailure} *)
   16.15  
   16.16 -qed_goal "MVOKBARFnotNR" MemoryImplementation.thy
   16.17 +qed_goalw "MVOKBARFnotNR" MemoryImplementation.thy [MVOKBARF_def]
   16.18     "!!x. MVOKBARF x ==> x ~= NotAResult"
   16.19 -   (fn _ => [ auto_tac (HOL_css addsimps2 (RP_simps @ [MVOKBARF_def])
   16.20 -			        addSEs2 [MemValNotAResultE])
   16.21 -	    ]);
   16.22 -bind_thm("MVOKBARFnotNRE", make_elim MVOKBARFnotNR);
   16.23 +   (fn _ => [ Auto_tac ]);
   16.24  
   16.25  (* ========================= Si's are mutually exclusive ==================================== *)
   16.26  (* Si and Sj are mutually exclusive for i # j. This helps to simplify the big
   16.27 @@ -33,240 +29,186 @@
   16.28  
   16.29  (* --- not used ---
   16.30  qed_goal "S1_excl" MemoryImplementation.thy 
   16.31 -     "$(S1 rmhist p) .-> $(S1 rmhist p) .& .~$(S2 rmhist p) .& .~$(S3 rmhist p) .& \
   16.32 -\                        .~$(S4 rmhist p) .& .~$(S5 rmhist p) .& .~$(S6 rmhist p)"
   16.33 +     "|- S1 rmhist p --> S1 rmhist p & ~S2 rmhist p & ~S3 rmhist p & \
   16.34 +\                        ~S4 rmhist p & ~S5 rmhist p & ~S6 rmhist p"
   16.35     (fn _ => [ auto_tac (MI_css addsimps2 [S_def, S1_def, S2_def,
   16.36                                            S3_def, S4_def, S5_def, S6_def])
   16.37              ]);
   16.38  *)
   16.39  
   16.40  qed_goal "S2_excl" MemoryImplementation.thy 
   16.41 -     "$(S2 rmhist p) .-> $(S2 rmhist p) .& .~$(S1 rmhist p)"
   16.42 +     "|- S2 rmhist p --> S2 rmhist p & ~S1 rmhist p"
   16.43     (fn _ => [ auto_tac (MI_css addsimps2 [S_def, S1_def, S2_def]) ]);
   16.44 -bind_thm("S2_exclE", action_impE S2_excl);
   16.45  
   16.46  qed_goal "S3_excl" MemoryImplementation.thy 
   16.47 -     "$(S3 rmhist p) .-> $(S3 rmhist p) .& .~$(S1 rmhist p) .& .~$(S2 rmhist p)"
   16.48 +     "|- S3 rmhist p --> S3 rmhist p & ~S1 rmhist p & ~S2 rmhist p"
   16.49     (fn _ => [ auto_tac (MI_css addsimps2 [S_def, S1_def, S2_def, S3_def]) ]);
   16.50 -bind_thm("S3_exclE", action_impE S3_excl);
   16.51  
   16.52  qed_goal "S4_excl" MemoryImplementation.thy 
   16.53 -     "$(S4 rmhist p) .-> $(S4 rmhist p) .& .~$(S1 rmhist p) .& .~$(S2 rmhist p) .& .~$(S3 rmhist p)"
   16.54 +     "|- S4 rmhist p --> S4 rmhist p & ~S1 rmhist p & ~S2 rmhist p & ~S3 rmhist p"
   16.55     (fn _ => [ auto_tac (MI_css addsimps2 [S_def,S1_def,S2_def,S3_def,S4_def]) ]);
   16.56 -bind_thm("S4_exclE", action_impE S4_excl);
   16.57  
   16.58  qed_goal "S5_excl" MemoryImplementation.thy 
   16.59 -     "$(S5 rmhist p) .-> $(S5 rmhist p) .& .~$(S1 rmhist p) .& .~$(S2 rmhist p) .& \
   16.60 -\                        .~$(S3 rmhist p) .& .~$(S4 rmhist p)"
   16.61 +     "|- S5 rmhist p --> S5 rmhist p & ~S1 rmhist p & ~S2 rmhist p \
   16.62 +\                        & ~S3 rmhist p & ~S4 rmhist p"
   16.63     (fn _ => [ auto_tac (MI_css addsimps2 [S_def,S1_def,S2_def,S3_def,S4_def,S5_def]) ]);
   16.64 -bind_thm("S5_exclE", action_impE S5_excl);
   16.65  
   16.66  qed_goal "S6_excl" MemoryImplementation.thy 
   16.67 -     "$(S6 rmhist p) .-> $(S6 rmhist p) .& .~$(S1 rmhist p) .& .~$(S2 rmhist p) .& \
   16.68 -\                        .~$(S3 rmhist p) .& .~$(S4 rmhist p) .& .~$(S5 rmhist p)"
   16.69 +     "|- S6 rmhist p --> S6 rmhist p & ~S1 rmhist p & ~S2 rmhist p  \
   16.70 +\                        & ~S3 rmhist p & ~S4 rmhist p & ~S5 rmhist p"
   16.71     (fn _ => [ auto_tac (MI_css addsimps2 [S_def,S1_def,S2_def,S3_def,S4_def,S5_def,S6_def]) ]);
   16.72 -bind_thm("S6_exclE", action_impE S6_excl);
   16.73  
   16.74  
   16.75  (* ==================== Lemmas about the environment ============================== *)
   16.76  
   16.77  qed_goal "Envbusy" MemoryImplementation.thy
   16.78 -   "$(Calling memCh p) .-> .~ ENext p"
   16.79 +   "|- $(Calling memCh p) --> ~ENext p"
   16.80     (fn _ => [ auto_tac (MI_css addsimps2 [ENext_def,Call_def]) ]);
   16.81  
   16.82  (* ==================== Lemmas about the implementation's states ==================== *)
   16.83  
   16.84  (* The following series of lemmas are used in establishing the implementation's
   16.85     next-state relation (Step 1.2 of the proof in the paper). For each state Si, we
   16.86 -   establish which component actions are possible and their results.
   16.87 +   determine which component actions are possible and what state they result in.
   16.88  *)
   16.89  
   16.90  (* ------------------------------ State S1 ---------------------------------------- *) 
   16.91  
   16.92  qed_goal "S1Env" MemoryImplementation.thy
   16.93 -   "(ENext p) .& $(S1 rmhist p) .& unchanged <c p, r p, m p, rmhist@p> .-> (S2 rmhist p)$"
   16.94 -   (fn _ => [auto_tac (MI_css
   16.95 -		       addsimps2 [ENext_def,Call_def,c_def,r_def,m_def,
   16.96 -				  caller_def,rtrner_def,MVNROKBA_def,
   16.97 -                                  S_def,S1_def,S2_def,Calling_def])
   16.98 +   "|- ENext p & $(S1 rmhist p) & unchanged (c p, r p, m p, rmhist!p) --> (S2 rmhist p)$"
   16.99 +   (fn _ => [force_tac (MI_css
  16.100 +		        addsimps2 [ENext_def,Call_def,c_def,r_def,m_def,
  16.101 +			   	   caller_def,rtrner_def,MVNROKBA_def,
  16.102 +                                   S_def,S1_def,S2_def,Calling_def]) 1
  16.103  	    ]);
  16.104 -bind_thm("S1EnvE", action_conjimpE S1Env);
  16.105  
  16.106  qed_goal "S1ClerkUnch" MemoryImplementation.thy 
  16.107 -   "[MClkNext memCh crCh cst p]_(c p) .& $(S1 rmhist p) .-> unchanged (c p)"
  16.108 -   (fn _ => [auto_tac (MI_fast_css addSEs2 [action_conjimpE MClkidle]
  16.109 -		                   addsimps2 [square_def,S_def,S1_def])
  16.110 -	    ]);
  16.111 -bind_thm("S1ClerkUnchE", action_conjimpE S1ClerkUnch);
  16.112 +   "|- [MClkNext memCh crCh cst p]_(c p) & $(S1 rmhist p) --> unchanged (c p)"
  16.113 +   (fn _ => [auto_tac (MI_fast_css addSDs2 [MClkidle] addsimps2 [S_def,S1_def]) ]);
  16.114  
  16.115  qed_goal "S1RPCUnch" MemoryImplementation.thy
  16.116 -   "[RPCNext crCh rmCh rst p]_(r p) .& $(S1 rmhist p) .-> unchanged (r p)"
  16.117 -   (fn _ => [auto_tac (MI_fast_css addSEs2 [action_impE RPCidle]
  16.118 -		                   addsimps2 [square_def,S_def,S1_def])
  16.119 -	    ]);
  16.120 -bind_thm("S1RPCUnchE", action_conjimpE S1RPCUnch);
  16.121 +   "|- [RPCNext crCh rmCh rst p]_(r p) & $(S1 rmhist p) --> unchanged (r p)"
  16.122 +   (fn _ => [auto_tac (MI_fast_css addSDs2 [RPCidle] addsimps2 [S_def,S1_def]) ]);
  16.123  
  16.124  qed_goal "S1MemUnch" MemoryImplementation.thy
  16.125 -   "[RNext rmCh mem ires p]_(m p) .& $(S1 rmhist p) .-> unchanged (m p)"
  16.126 -   (fn _ => [auto_tac (MI_fast_css addSEs2 [action_impE Memoryidle]
  16.127 -		                   addsimps2 [square_def,S_def,S1_def])
  16.128 -	    ]);
  16.129 -bind_thm("S1MemUnchE", action_conjimpE S1MemUnch);
  16.130 +   "|- [RNext rmCh mm ires p]_(m p) & $(S1 rmhist p) --> unchanged (m p)"
  16.131 +   (fn _ => [auto_tac (MI_fast_css addSDs2 [Memoryidle] addsimps2 [S_def,S1_def]) ]);
  16.132  
  16.133  qed_goal "S1Hist" MemoryImplementation.thy
  16.134 -   "[HNext rmhist p]_<c p,r p,m p,rmhist@p> .& $(S1 rmhist p) .-> unchanged (rmhist@p)"
  16.135 -   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,HNext_def,MemReturn_def,
  16.136 -					      RPCFail_def,MClkReply_def,Return_def,
  16.137 -		                              S_def,S1_def])
  16.138 +   "|- [HNext rmhist p]_(c p,r p,m p,rmhist!p) & $(S1 rmhist p) --> unchanged (rmhist!p)"
  16.139 +   (fn _ => [action_simp_tac (simpset() addsimps [HNext_def, S_def, S1_def, MemReturn_def, 
  16.140 +                                                  RPCFail_def,MClkReply_def,Return_def])
  16.141 +                             [] [squareE] 1
  16.142  	    ]);
  16.143 -bind_thm("S1HistE", action_conjimpE S1Hist);
  16.144  
  16.145  (* ------------------------------ State S2 ---------------------------------------- *)
  16.146  
  16.147  qed_goal "S2EnvUnch" MemoryImplementation.thy
  16.148 -   "[ENext p]_(e p) .& $(S2 rmhist p) .-> unchanged (e p)"
  16.149 -   (fn _ => [auto_tac (MI_fast_css addSEs2 [action_impE Envbusy]
  16.150 -		                   addsimps2 [square_def,S_def,S2_def])
  16.151 -	    ]);
  16.152 -bind_thm("S2EnvUnchE", action_conjimpE S2EnvUnch);
  16.153 +   "|- [ENext p]_(e p) & $(S2 rmhist p) --> unchanged (e p)"
  16.154 +   (fn _ => [auto_tac (MI_css addSDs2 [Envbusy] addsimps2 [S_def,S2_def]) ]);
  16.155  
  16.156  qed_goal "S2Clerk" MemoryImplementation.thy
  16.157 -   "MClkNext memCh crCh cst p .& $(S2 rmhist p) .-> MClkFwd memCh crCh cst p"
  16.158 -   (fn _ => [auto_tac (MI_fast_css addsimps2 [MClkNext_def,MClkRetry_def,MClkReply_def,
  16.159 -					      S_def,S2_def])
  16.160 +   "|- MClkNext memCh crCh cst p & $(S2 rmhist p) --> MClkFwd memCh crCh cst p"
  16.161 +   (fn _ => [auto_tac (MI_css addsimps2 [MClkNext_def,MClkRetry_def,MClkReply_def,
  16.162 +					 S_def,S2_def])
  16.163  	    ]);
  16.164 -bind_thm("S2ClerkE", action_conjimpE S2Clerk);
  16.165  
  16.166 -(* The dumb action_simp_tac wins 15 : 129 over auto_tac *)
  16.167  qed_goal "S2Forward" MemoryImplementation.thy
  16.168 -   "$(S2 rmhist p) .& (MClkFwd memCh crCh cst p) .& unchanged <e p, r p, m p, rmhist@p> \
  16.169 -\   .-> (S3 rmhist p)$"
  16.170 +   "|- $(S2 rmhist p) & MClkFwd memCh crCh cst p & unchanged (e p, r p, m p, rmhist!p) \
  16.171 +\      --> (S3 rmhist p)$"
  16.172     (fn _ => [action_simp_tac (simpset() addsimps
  16.173                  [MClkFwd_def,Call_def,e_def,r_def,m_def,caller_def,rtrner_def,
  16.174                   S_def,S2_def,S3_def,Calling_def])
  16.175                 [] [] 1
  16.176  	     ]);
  16.177 -bind_thm("S2ForwardE", action_conjimpE S2Forward);
  16.178  
  16.179  qed_goal "S2RPCUnch" MemoryImplementation.thy
  16.180 -   "[RPCNext crCh rmCh rst p]_(r p) .& $(S2 rmhist p) .-> unchanged (r p)"
  16.181 -   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,S_def,S2_def]
  16.182 -		                   addSEs2 [action_impE RPCidle])
  16.183 -	    ]);
  16.184 -bind_thm("S2RPCUnchE", action_conjimpE S2RPCUnch);
  16.185 +   "|- [RPCNext crCh rmCh rst p]_(r p) & $(S2 rmhist p) --> unchanged (r p)"
  16.186 +   (fn _ => [auto_tac (MI_css addsimps2 [S_def,S2_def] addSDs2 [RPCidle]) ]);
  16.187  
  16.188  qed_goal "S2MemUnch" MemoryImplementation.thy
  16.189 -   "[RNext rmCh mem ires p]_(m p) .& $(S2 rmhist p) .-> unchanged (m p)"
  16.190 -   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,S_def,S2_def]
  16.191 -		                   addSEs2 [action_impE Memoryidle])
  16.192 -	    ]);
  16.193 -bind_thm("S2MemUnchE", action_conjimpE S2MemUnch);
  16.194 +   "|- [RNext rmCh mm ires p]_(m p) & $(S2 rmhist p) --> unchanged (m p)"
  16.195 +   (fn _ => [auto_tac (MI_css addsimps2 [S_def,S2_def] addSDs2 [Memoryidle]) ]);
  16.196  
  16.197  qed_goal "S2Hist" MemoryImplementation.thy
  16.198 -   "[HNext rmhist p]_<c p,r p,m p,rmhist@p> .& $(S2 rmhist p) .-> unchanged (rmhist@p)"
  16.199 +   "|- [HNext rmhist p]_(c p,r p,m p,rmhist!p) & $(S2 rmhist p) --> unchanged (rmhist!p)"
  16.200     (fn _ => [auto_tac (MI_fast_css
  16.201 -		       addsimps2 [square_def,HNext_def,MemReturn_def,
  16.202 +		       addsimps2 [HNext_def,MemReturn_def,
  16.203  				  RPCFail_def,MClkReply_def,Return_def,S_def,S2_def])
  16.204  	    ]);
  16.205 -bind_thm("S2HistE", action_conjimpE S2Hist);
  16.206  
  16.207  (* ------------------------------ State S3 ---------------------------------------- *)
  16.208  
  16.209  qed_goal "S3EnvUnch" MemoryImplementation.thy
  16.210 -   "[ENext p]_(e p) .& $(S3 rmhist p) .-> unchanged (e p)"
  16.211 -   (fn _ => [auto_tac (MI_fast_css addSEs2 [action_impE Envbusy]
  16.212 -		                   addsimps2 [square_def,S_def,S3_def])
  16.213 -	    ]);
  16.214 -bind_thm("S3EnvUnchE", action_conjimpE S3EnvUnch);
  16.215 +   "|- [ENext p]_(e p) & $(S3 rmhist p) --> unchanged (e p)"
  16.216 +   (fn _ => [auto_tac (MI_css addSDs2 [Envbusy] addsimps2 [S_def,S3_def]) ]);
  16.217  
  16.218  qed_goal "S3ClerkUnch" MemoryImplementation.thy 
  16.219 -   "[MClkNext memCh crCh cst p]_(c p) .& $(S3 rmhist p) .-> unchanged (c p)"
  16.220 -   (fn _ => [auto_tac (MI_fast_css addSEs2 [action_impE MClkbusy]
  16.221 -		                   addsimps2 [square_def,S_def,S3_def])
  16.222 -	    ]);
  16.223 -bind_thm("S3ClerkUnchE", action_conjimpE S3ClerkUnch);
  16.224 +   "|- [MClkNext memCh crCh cst p]_(c p) & $(S3 rmhist p) --> unchanged (c p)"
  16.225 +   (fn _ => [auto_tac (MI_css addSDs2 [MClkbusy] addsimps2 [square_def,S_def,S3_def]) ]);
  16.226  
  16.227  qed_goal "S3LegalRcvArg" MemoryImplementation.thy
  16.228 -   "$(S3 rmhist p) .-> IsLegalRcvArg[ arg[$(crCh@p)] ]"
  16.229 -   (fn _ => [action_simp_tac
  16.230 -	       (simpset() addsimps [IsLegalRcvArg_def,MClkRelayArg_def,S_def,S3_def])
  16.231 -	       [exI] [] 1
  16.232 -	    ]);
  16.233 +   "|- S3 rmhist p --> IsLegalRcvArg<arg<crCh!p>>"
  16.234 +   (fn _ => [auto_tac (MI_css addsimps2 [IsLegalRcvArg_def,MClkRelayArg_def,S_def,S3_def]) ]);
  16.235  
  16.236  qed_goal "S3RPC" MemoryImplementation.thy
  16.237 -   "(RPCNext crCh rmCh rst p) .& $(S3 rmhist p) \
  16.238 -\   .-> (RPCFwd crCh rmCh rst p) .| (RPCFail crCh rmCh rst p)"
  16.239 -   (fn _ => [auto_tac MI_css,
  16.240 -             etac ((rewrite_rule action_rews (S3LegalRcvArg RS actionD)) RS impdupE) 1,
  16.241 +   "|- RPCNext crCh rmCh rst p & $(S3 rmhist p) \
  16.242 +\      --> RPCFwd crCh rmCh rst p | RPCFail crCh rmCh rst p"
  16.243 +   (fn _ => [Clarsimp_tac 1,
  16.244 +             forward_tac [action_use S3LegalRcvArg] 1,
  16.245  	     auto_tac (MI_css addsimps2 [RPCNext_def,RPCReject_def,RPCReply_def,S_def,S3_def])
  16.246  	    ]);
  16.247 -bind_thm("S3RPCE", action_conjimpE S3RPC);
  16.248  
  16.249  qed_goal "S3Forward" MemoryImplementation.thy
  16.250 -   "(RPCFwd crCh rmCh rst p) .& HNext rmhist p .& $(S3 rmhist p) .& unchanged <e p, c p, m p> \
  16.251 -\   .-> (S4 rmhist p)$ .& unchanged (rmhist@p)"
  16.252 +   "|- RPCFwd crCh rmCh rst p & HNext rmhist p & $(S3 rmhist p) & unchanged (e p, c p, m p) \
  16.253 +\      --> (S4 rmhist p)$ & unchanged (rmhist!p)"
  16.254     (fn _ => [action_simp_tac 
  16.255                 (simpset() addsimps [RPCFwd_def,HNext_def,MemReturn_def,RPCFail_def,MClkReply_def,
  16.256  				   Return_def,Call_def,e_def,c_def,m_def,caller_def,rtrner_def, 
  16.257  				   S_def,S3_def,S4_def,Calling_def])
  16.258  	       [] [] 1
  16.259  	    ]);
  16.260 -bind_thm("S3ForwardE", action_conjimpE S3Forward);
  16.261  
  16.262  qed_goal "S3Fail" MemoryImplementation.thy
  16.263 -   "(RPCFail crCh rmCh rst p) .& $(S3 rmhist p) .& HNext rmhist p .& unchanged <e p, c p, m p> \
  16.264 -\   .-> (S6 rmhist p)$"
  16.265 +   "|- RPCFail crCh rmCh rst p & $(S3 rmhist p) & HNext rmhist p & unchanged (e p, c p, m p) \
  16.266 +\      --> (S6 rmhist p)$"
  16.267     (fn _ => [action_simp_tac 
  16.268                 (simpset() addsimps [HNext_def,RPCFail_def,Return_def,e_def,c_def,m_def,
  16.269  				   caller_def,rtrner_def,MVOKBARF_def,
  16.270  				   S_def,S3_def,S6_def,Calling_def])
  16.271                 [] [] 1
  16.272  	    ]);
  16.273 -bind_thm("S3FailE", action_conjimpE S3Fail);
  16.274  
  16.275  qed_goal "S3MemUnch" MemoryImplementation.thy
  16.276 -   "[RNext rmCh mem ires p]_(m p) .& $(S3 rmhist p) .-> unchanged (m p)"
  16.277 -   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,S_def,S3_def]
  16.278 -		                   addSEs2 [action_impE Memoryidle])
  16.279 -	    ]);
  16.280 -bind_thm("S3MemUnchE", action_conjimpE S3MemUnch);
  16.281 +   "|- [RNext rmCh mm ires p]_(m p) & $(S3 rmhist p) --> unchanged (m p)"
  16.282 +   (fn _ => [auto_tac (MI_css addsimps2 [S_def,S3_def] addSDs2 [Memoryidle]) ]);
  16.283  
  16.284  qed_goal "S3Hist" MemoryImplementation.thy
  16.285 -   "HNext rmhist p .& $(S3 rmhist p) .& unchanged (r p) .-> unchanged (rmhist@p)"
  16.286 -   (fn _ => [auto_tac (MI_fast_css
  16.287 +   "|- HNext rmhist p & $(S3 rmhist p) & unchanged (r p) --> unchanged (rmhist!p)"
  16.288 +   (fn _ => [auto_tac (MI_css
  16.289  		       addsimps2 [HNext_def,MemReturn_def,RPCFail_def,MClkReply_def,
  16.290  				  Return_def,r_def,rtrner_def,S_def,S3_def,Calling_def])
  16.291  	    ]);
  16.292 -bind_thm("S3HistE", action_conjimpE S3Hist);
  16.293  
  16.294  
  16.295  (* ------------------------------ State S4 ---------------------------------------- *)
  16.296  
  16.297  qed_goal "S4EnvUnch" MemoryImplementation.thy
  16.298 -   "[ENext p]_(e p) .& $(S4 rmhist p) .-> unchanged (e p)"
  16.299 -   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,S_def,S4_def]
  16.300 -		                   addSEs2 [action_impE Envbusy])
  16.301 -	    ]);
  16.302 -bind_thm("S4EnvUnchE", action_conjimpE S4EnvUnch);
  16.303 +   "|- [ENext p]_(e p) & $(S4 rmhist p) --> unchanged (e p)"
  16.304 +   (fn _ => [auto_tac (MI_css addsimps2 [S_def,S4_def] addSDs2 [Envbusy]) ]);
  16.305  
  16.306  qed_goal "S4ClerkUnch" MemoryImplementation.thy
  16.307 -   "[MClkNext memCh crCh cst p]_(c p) .& $(S4 rmhist p) .-> unchanged (c p)"
  16.308 -   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,S_def,S4_def]
  16.309 -		                   addSEs2 [action_impE MClkbusy])
  16.310 -	    ]);
  16.311 -bind_thm("S4ClerkUnchE", action_conjimpE S4ClerkUnch);
  16.312 +   "|- [MClkNext memCh crCh cst p]_(c p) & $(S4 rmhist p) --> unchanged (c p)"
  16.313 +   (fn _ => [auto_tac (MI_css addsimps2 [S_def,S4_def] addSDs2 [MClkbusy]) ]);
  16.314  
  16.315  qed_goal "S4RPCUnch" MemoryImplementation.thy
  16.316 -   "[RPCNext crCh rmCh rst p]_(r p) .& $(S4 rmhist p) .-> unchanged (r p)"
  16.317 -   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,S_def,S4_def]
  16.318 -		                   addSEs2 [action_conjimpE RPCbusy])
  16.319 -	    ]);
  16.320 -bind_thm("S4RPCUnchE", action_conjimpE S4RPCUnch);
  16.321 +   "|- [RPCNext crCh rmCh rst p]_(r p) & $(S4 rmhist p) --> unchanged (r p)"
  16.322 +   (fn _ => [auto_tac (MI_fast_css addsimps2 [S_def,S4_def] addSDs2 [RPCbusy]) ]);
  16.323  
  16.324  qed_goal "S4ReadInner" MemoryImplementation.thy
  16.325 -   "(ReadInner rmCh mem ires p l) .& $(S4 rmhist p) .& unchanged <e p, c p, r p> \
  16.326 -\        .& (HNext rmhist p) .& $(MemInv mem l) \
  16.327 -\   .-> (S4 rmhist p)$ .& unchanged (rmhist@p)"
  16.328 +   "|- ReadInner rmCh mm ires p l & $(S4 rmhist p) & unchanged (e p, c p, r p) \
  16.329 +\           & HNext rmhist p & $(MemInv mm l) \
  16.330 +\      --> (S4 rmhist p)$ & unchanged (rmhist!p)"
  16.331     (fn _ => [action_simp_tac 
  16.332                 (simpset() addsimps [ReadInner_def,GoodRead_def, BadRead_def,HNext_def,
  16.333  				   MemReturn_def, RPCFail_def,MClkReply_def,Return_def,
  16.334 @@ -276,17 +218,15 @@
  16.335  	    ]);
  16.336  
  16.337  qed_goal "S4Read" MemoryImplementation.thy
  16.338 -   "(Read rmCh mem ires p) .& $(S4 rmhist p) .& unchanged <e p, c p, r p> \
  16.339 -\         .& (HNext rmhist p) .& (RALL l. $(MemInv mem l)) \
  16.340 -\   .-> (S4 rmhist p)$ .& unchanged (rmhist@p)"
  16.341 -   (fn _ => [auto_tac (MI_fast_css addsimps2 [Read_def]
  16.342 -		                   addSEs2 [action_conjimpE S4ReadInner])
  16.343 -	    ]);
  16.344 -bind_thm("S4ReadE", action_conjimpE S4Read);
  16.345 +   "|- Read rmCh mm ires p & $(S4 rmhist p) & unchanged (e p, c p, r p) \
  16.346 +\           & HNext rmhist p & (!l. $MemInv mm l) \
  16.347 +\      --> (S4 rmhist p)$ & unchanged (rmhist!p)"
  16.348 +   (fn _ => [auto_tac (MI_css addsimps2 [Read_def] addSDs2 [S4ReadInner]) ]);
  16.349  
  16.350  qed_goal "S4WriteInner" MemoryImplementation.thy
  16.351 -   "(WriteInner rmCh mem ires p l v) .& $(S4 rmhist p) .& unchanged <e p, c p, r p> .& (HNext rmhist p) \
  16.352 -\   .-> (S4 rmhist p)$ .& unchanged (rmhist@p)"
  16.353 +   "|- WriteInner rmCh mm ires p l v & $(S4 rmhist p) & unchanged (e p, c p, r p) \
  16.354 +\           & HNext rmhist p \
  16.355 +\      --> (S4 rmhist p)$ & unchanged (rmhist!p)"
  16.356     (fn _ => [action_simp_tac 
  16.357                 (simpset() addsimps [WriteInner_def,GoodWrite_def, BadWrite_def,HNext_def,
  16.358  				   MemReturn_def,RPCFail_def,MClkReply_def,Return_def,
  16.359 @@ -296,64 +236,53 @@
  16.360  	    ]);
  16.361  
  16.362  qed_goal "S4Write" MemoryImplementation.thy
  16.363 -   "(Write rmCh mem ires p l) .& $(S4 rmhist p) .& unchanged <e p, c p, r p> .& (HNext rmhist p) \
  16.364 -\   .-> (S4 rmhist p)$ .& unchanged (rmhist@p)"
  16.365 -   (fn _ => [ auto_tac (MI_css addsimps2 [Write_def] addSEs2 [action_conjimpE S4WriteInner]) ]);
  16.366 -bind_thm("S4WriteE", action_conjimpE S4Write);
  16.367 +   "|- Write rmCh mm ires p l & $(S4 rmhist p) & unchanged (e p, c p, r p) & (HNext rmhist p) \
  16.368 +\      --> (S4 rmhist p)$ & unchanged (rmhist!p)"
  16.369 +   (fn _ => [ auto_tac (MI_css addsimps2 [Write_def] addSDs2 [S4WriteInner]) ]);
  16.370  
  16.371  qed_goal "WriteS4" MemoryImplementation.thy
  16.372 -   "$(ImpInv rmhist p) .& (Write rmCh mem ires p l) .-> $(S4 rmhist p)"
  16.373 -   (fn _ => [auto_tac (MI_fast_css
  16.374 +   "|- $ImpInv rmhist p & Write rmCh mm ires p l --> $S4 rmhist p"
  16.375 +   (fn _ => [auto_tac (MI_css
  16.376  		       addsimps2 [Write_def,WriteInner_def,ImpInv_def,WrRequest_def,
  16.377  				  S_def,S1_def,S2_def,S3_def,S4_def,S5_def,S6_def])
  16.378              ]);
  16.379 -bind_thm("WriteS4E", action_conjimpE WriteS4);
  16.380  
  16.381  qed_goal "S4Return" MemoryImplementation.thy
  16.382 -   "(MemReturn rmCh ires p) .& $(S4 rmhist p) .& unchanged <e p, c p, r p> .& (HNext rmhist p) \
  16.383 -\   .-> (S5 rmhist p)$"
  16.384 -   (fn _ => [auto_tac (MI_fast_css
  16.385 +   "|- MemReturn rmCh ires p & $S4 rmhist p & unchanged (e p, c p, r p) & HNext rmhist p \
  16.386 +\      --> (S5 rmhist p)$"
  16.387 +   (fn _ => [auto_tac (MI_css
  16.388  		       addsimps2 [HNext_def,MemReturn_def,Return_def,e_def,c_def,r_def,
  16.389  				  rtrner_def,caller_def,MVNROKBA_def,MVOKBA_def,
  16.390  		                  S_def,S4_def,S5_def,Calling_def])
  16.391  	    ]);
  16.392 -bind_thm("S4ReturnE", action_conjimpE S4Return);
  16.393  
  16.394  qed_goal "S4Hist" MemoryImplementation.thy
  16.395 -   "(HNext rmhist p) .& $(S4 rmhist p) .& (m p)$ .= $(m p) .-> (rmhist@p)$ .= $(rmhist@p)"
  16.396 -   (fn _ => [auto_tac (MI_fast_css
  16.397 +   "|- HNext rmhist p & $S4 rmhist p & (m p)$ = $(m p) --> (rmhist!p)$ = $(rmhist!p)"
  16.398 +   (fn _ => [auto_tac (MI_css
  16.399  		       addsimps2 [HNext_def,MemReturn_def,RPCFail_def,MClkReply_def,
  16.400  				  Return_def,m_def,rtrner_def,S_def,S4_def,Calling_def])
  16.401  	    ]);
  16.402 -bind_thm("S4HistE", action_conjimpE S4Hist);
  16.403  
  16.404  (* ------------------------------ State S5 ---------------------------------------- *)
  16.405  
  16.406  qed_goal "S5EnvUnch" MemoryImplementation.thy
  16.407 -   "[ENext p]_(e p) .& $(S5 rmhist p) .-> unchanged (e p)"
  16.408 -   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,S_def,S5_def]
  16.409 -		                   addSEs2 [action_impE Envbusy])
  16.410 -	    ]);
  16.411 -bind_thm("S5EnvUnchE", action_conjimpE S5EnvUnch);
  16.412 +   "|- [ENext p]_(e p) & $(S5 rmhist p) --> unchanged (e p)"
  16.413 +   (fn _ => [auto_tac (MI_css addsimps2 [S_def,S5_def] addSDs2 [Envbusy]) ]);
  16.414  
  16.415  qed_goal "S5ClerkUnch" MemoryImplementation.thy
  16.416 -   "[MClkNext memCh crCh cst p]_(c p) .& $(S5 rmhist p) .-> unchanged (c p)"
  16.417 -   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,S_def,S5_def]
  16.418 -		                   addSEs2 [action_impE MClkbusy])
  16.419 -	    ]);
  16.420 -bind_thm("S5ClerkUnchE", action_conjimpE S5ClerkUnch);
  16.421 +   "|- [MClkNext memCh crCh cst p]_(c p) & $(S5 rmhist p) --> unchanged (c p)"
  16.422 +   (fn _ => [auto_tac (MI_css addsimps2 [S_def,S5_def] addSDs2 [MClkbusy]) ]);
  16.423  
  16.424  qed_goal "S5RPC" MemoryImplementation.thy
  16.425 -   "(RPCNext crCh rmCh rst p) .& $(S5 rmhist p)   \
  16.426 -\   .-> (RPCReply crCh rmCh rst p) .| (RPCFail crCh rmCh rst p)"
  16.427 -   (fn _ => [auto_tac (MI_fast_css
  16.428 +   "|- RPCNext crCh rmCh rst p & $(S5 rmhist p)   \
  16.429 +\      --> RPCReply crCh rmCh rst p | RPCFail crCh rmCh rst p"
  16.430 +   (fn _ => [auto_tac (MI_css
  16.431  		       addsimps2 [RPCNext_def,RPCReject_def,RPCFwd_def,S_def,S5_def])
  16.432  	    ]);
  16.433 -bind_thm("S5RPCE", action_conjimpE S5RPC);
  16.434  
  16.435  qed_goal "S5Reply" MemoryImplementation.thy
  16.436 -   "(RPCReply crCh rmCh rst p) .& $(S5 rmhist p) .& unchanged <e p, c p, m p,rmhist@p> \
  16.437 -\    .-> (S6 rmhist p)$"
  16.438 +   "|- RPCReply crCh rmCh rst p & $(S5 rmhist p) & unchanged (e p, c p, m p,rmhist!p) \
  16.439 +\      --> (S6 rmhist p)$"
  16.440     (fn _ => [action_simp_tac 
  16.441                 (simpset()
  16.442  		addsimps [RPCReply_def,Return_def,e_def,c_def,m_def,
  16.443 @@ -361,11 +290,10 @@
  16.444  			  S_def,S5_def,S6_def,Calling_def])
  16.445                 [] [] 1
  16.446  	    ]);
  16.447 -bind_thm("S5ReplyE", action_conjimpE S5Reply);
  16.448  
  16.449  qed_goal "S5Fail" MemoryImplementation.thy
  16.450 -   "(RPCFail crCh rmCh rst p) .& $(S5 rmhist p) .& unchanged <e p, c p, m p,rmhist@p>\
  16.451 -\     .-> (S6 rmhist p)$"
  16.452 +   "|- RPCFail crCh rmCh rst p & $(S5 rmhist p) & unchanged (e p, c p, m p,rmhist!p) \
  16.453 +\      --> (S6 rmhist p)$"
  16.454     (fn _ => [action_simp_tac
  16.455  	       (simpset()
  16.456  		addsimps [RPCFail_def,Return_def,e_def,c_def,m_def,
  16.457 @@ -373,77 +301,60 @@
  16.458  			  S_def,S5_def,S6_def,Calling_def])
  16.459                 [] [] 1
  16.460  	    ]);
  16.461 -bind_thm("S5FailE", action_conjimpE S5Fail);
  16.462  
  16.463  qed_goal "S5MemUnch" MemoryImplementation.thy
  16.464 -   "[RNext rmCh mem ires p]_(m p) .& $(S5 rmhist p) .-> unchanged (m p)"
  16.465 -   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,S_def,S5_def]
  16.466 -		                   addSEs2 [action_impE Memoryidle])
  16.467 -	    ]);
  16.468 -bind_thm("S5MemUnchE", action_conjimpE S5MemUnch);
  16.469 +   "|- [RNext rmCh mm ires p]_(m p) & $(S5 rmhist p) --> unchanged (m p)"
  16.470 +   (fn _ => [auto_tac (MI_css addsimps2 [S_def,S5_def] addSDs2 [Memoryidle]) ]);
  16.471  
  16.472  qed_goal "S5Hist" MemoryImplementation.thy
  16.473 -   "[HNext rmhist p]_<c p, r p, m p, rmhist@p> .& $(S5 rmhist p) .-> (rmhist@p)$ .= $(rmhist@p)"
  16.474 +   "|- [HNext rmhist p]_(c p, r p, m p, rmhist!p) & $(S5 rmhist p) --> (rmhist!p)$ = $(rmhist!p)"
  16.475     (fn _ => [auto_tac (MI_fast_css
  16.476 -		       addsimps2 [square_def,HNext_def,MemReturn_def,
  16.477 +		       addsimps2 [HNext_def,MemReturn_def,
  16.478  				  RPCFail_def,MClkReply_def,Return_def,S_def,S5_def])
  16.479  	    ]);
  16.480 -bind_thm("S5HistE", action_conjimpE S5Hist);
  16.481  
  16.482  (* ------------------------------ State S6 ---------------------------------------- *)
  16.483  
  16.484  qed_goal "S6EnvUnch" MemoryImplementation.thy
  16.485 -   "[ENext p]_(e p) .& $(S6 rmhist p) .-> unchanged (e p)"
  16.486 -   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,S_def,S6_def]
  16.487 -		                   addSEs2 [action_impE Envbusy])
  16.488 -	    ]);
  16.489 -bind_thm("S6EnvUnchE", action_conjimpE S6EnvUnch);
  16.490 +   "|- [ENext p]_(e p) & $(S6 rmhist p) --> unchanged (e p)"
  16.491 +   (fn _ => [auto_tac (MI_css addsimps2 [S_def,S6_def] addSDs2 [Envbusy]) ]);
  16.492  
  16.493  qed_goal "S6Clerk" MemoryImplementation.thy
  16.494 -   "(MClkNext memCh crCh cst p) .& $(S6 rmhist p) \
  16.495 -\    .-> (MClkRetry memCh crCh cst p) .| (MClkReply memCh crCh cst p)"
  16.496 -   (fn _ => [ auto_tac (MI_fast_css addsimps2 [MClkNext_def,MClkFwd_def,S_def,S6_def]) ]);
  16.497 -bind_thm("S6ClerkE", action_conjimpE S6Clerk);
  16.498 +   "|- MClkNext memCh crCh cst p & $(S6 rmhist p) \
  16.499 +\      --> MClkRetry memCh crCh cst p | MClkReply memCh crCh cst p"
  16.500 +   (fn _ => [ auto_tac (MI_css addsimps2 [MClkNext_def,MClkFwd_def,S_def,S6_def]) ]);
  16.501  
  16.502  qed_goal "S6Retry" MemoryImplementation.thy
  16.503 -   "(MClkRetry memCh crCh cst p) .& (HNext rmhist p) .& $(S6 rmhist p) .& unchanged<e p,r p,m p> \
  16.504 -\     .-> (S3 rmhist p)$ .& unchanged (rmhist@p)"
  16.505 +   "|- MClkRetry memCh crCh cst p & HNext rmhist p & $S6 rmhist p & unchanged (e p,r p,m p) \
  16.506 +\      --> (S3 rmhist p)$ & unchanged (rmhist!p)"
  16.507     (fn _ => [action_simp_tac
  16.508  	        (simpset() addsimps [HNext_def,MClkReply_def,MClkRetry_def,Call_def,
  16.509  				    Return_def,e_def,r_def,m_def,caller_def,rtrner_def,
  16.510  		                    S_def,S6_def,S3_def,Calling_def])
  16.511                  [] [] 1]);
  16.512 -bind_thm("S6RetryE", action_conjimpE S6Retry);
  16.513  
  16.514  qed_goal "S6Reply" MemoryImplementation.thy
  16.515 -   "(MClkReply memCh crCh cst p) .& (HNext rmhist p) .& $(S6 rmhist p) .& unchanged<e p,r p,m p> \
  16.516 -\     .-> (S1 rmhist p)$"
  16.517 +   "|- MClkReply memCh crCh cst p & HNext rmhist p & $S6 rmhist p & unchanged (e p,r p,m p) \
  16.518 +\      --> (S1 rmhist p)$"
  16.519     (fn _ => [action_simp_tac (simpset()
  16.520  			      addsimps [HNext_def,MemReturn_def,RPCFail_def,Return_def,
  16.521  					MClkReply_def,e_def,r_def,m_def,caller_def,rtrner_def,
  16.522  					S_def,S6_def,S1_def,Calling_def])
  16.523  	                     [] [] 1
  16.524  	    ]);
  16.525 -bind_thm("S6ReplyE", action_conjimpE S6Reply);
  16.526  
  16.527  qed_goal "S6RPCUnch" MemoryImplementation.thy
  16.528 -   "[RPCNext crCh rmCh rst p]_(r p) .& $(S6 rmhist p) .-> unchanged (r p)"
  16.529 -   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,S_def,S6_def]
  16.530 -		                   addSEs2 [action_impE RPCidle])
  16.531 -	    ]);
  16.532 -bind_thm("S6RPCUnchE", action_conjimpE S6RPCUnch);
  16.533 +   "|- [RPCNext crCh rmCh rst p]_(r p) & $S6 rmhist p --> unchanged (r p)"
  16.534 +   (fn _ => [auto_tac (MI_css addsimps2 [S_def,S6_def] addSDs2 [RPCidle]) ]);
  16.535  
  16.536  qed_goal "S6MemUnch" MemoryImplementation.thy
  16.537 -   "[RNext rmCh mem ires p]_(m p) .& $(S6 rmhist p) .-> unchanged (m p)"
  16.538 -   (fn _ => [auto_tac (MI_fast_css addsimps2 [square_def,S_def,S6_def]
  16.539 -		                   addSEs2 [action_impE Memoryidle])
  16.540 -	    ]);
  16.541 -bind_thm("S6MemUnchE", action_conjimpE S6MemUnch);
  16.542 +   "|- [RNext rmCh mm ires p]_(m p) & $(S6 rmhist p) --> unchanged (m p)"
  16.543 +   (fn _ => [auto_tac (MI_css addsimps2 [S_def,S6_def] addSDs2 [Memoryidle]) ]);
  16.544  
  16.545  qed_goal "S6Hist" MemoryImplementation.thy
  16.546 -   "(HNext rmhist p) .& $(S6 rmhist p) .& (c p)$ .= $(c p) .-> (rmhist@p)$ .= $(rmhist@p)"
  16.547 -   (fn _ => [auto_tac (MI_fast_css
  16.548 +   "|- HNext rmhist p & $S6 rmhist p & (c p)$ = $(c p) --> (rmhist!p)$ = $(rmhist!p)"
  16.549 +   (fn _ => [auto_tac (MI_css
  16.550  		       addsimps2 [HNext_def,MClkReply_def,Return_def,c_def,rtrner_def,
  16.551  		                  S_def,S6_def,Calling_def])
  16.552  	    ]);
  16.553 -bind_thm("S6HistE", action_conjimpE S6Hist);
  16.554 +
    17.1 --- a/src/HOL/TLA/Memory/MemClerk.ML	Mon Feb 08 13:02:42 1999 +0100
    17.2 +++ b/src/HOL/TLA/Memory/MemClerk.ML	Mon Feb 08 13:02:56 1999 +0100
    17.3 @@ -3,69 +3,60 @@
    17.4      Author:      Stephan Merz
    17.5      Copyright:   1997 University of Munich
    17.6  
    17.7 -    RPC-Memory example: Memory clerk specification (ML file)
    17.8 +    RPC-Memory example: Memory clerk specification (theorems and proofs)
    17.9  *)
   17.10  
   17.11  val MC_action_defs = 
   17.12 -   [MClkInit_def RS inteq_reflection]
   17.13 -   @ [MClkFwd_def, MClkRetry_def, MClkReply_def, MClkNext_def];
   17.14 +   [MClkInit_def, MClkFwd_def, MClkRetry_def, MClkReply_def, MClkNext_def];
   17.15  
   17.16  val MC_temp_defs = [MClkIPSpec_def, MClkISpec_def];
   17.17  
   17.18 +val mem_css = (claset(), simpset());
   17.19 +
   17.20  (* The Clerk engages in an action for process p only if there is an outstanding,
   17.21     unanswered call for that process.
   17.22  *)
   17.23  
   17.24  qed_goal "MClkidle" MemClerk.thy
   17.25 -   ".~ $(Calling send p) .& ($(cst@p) .= #clkA) .-> .~ MClkNext send rcv cst p"
   17.26 -   (fn _ => [ auto_tac (claset(),
   17.27 -                        simpset() addsimps (MC_action_defs @ [Return_def]))
   17.28 -            ]);
   17.29 +   "|- ~$Calling send p & $(cst!p) = #clkA --> ~MClkNext send rcv cst p"
   17.30 +   (fn _ => [ auto_tac (mem_css addsimps2 (Return_def::MC_action_defs)) ]);
   17.31  
   17.32  qed_goal "MClkbusy" MemClerk.thy
   17.33 -   "$(Calling rcv p) .-> .~ MClkNext send rcv cst p"
   17.34 -   (fn _ => [ auto_tac (claset(),
   17.35 -                        simpset() addsimps (MC_action_defs @ [Call_def]))
   17.36 -            ]);
   17.37 -
   17.38 -(* unlifted versions as introduction rules *)
   17.39 -
   17.40 -bind_thm("MClkidleI", action_mp MClkidle);
   17.41 -bind_thm("MClkbusyI", action_mp MClkbusy);
   17.42 +   "|- $Calling rcv p --> ~MClkNext send rcv cst p"
   17.43 +   (fn _ => [ auto_tac (mem_css addsimps2 (MC_action_defs @ [Call_def])) ]);
   17.44  
   17.45  (* Enabledness of actions *)
   17.46  
   17.47  qed_goal "MClkFwd_enabled" MemClerk.thy
   17.48 -   "!!p. base_var <rtrner send @ p, caller rcv @ p, cst@p> ==> \
   17.49 -\        $(Calling send p) .& .~ $(Calling rcv p) .& ($(cst@p) .= #clkA)  \
   17.50 -\        .-> $(Enabled (MClkFwd send rcv cst p))"
   17.51 +   "!!p. basevars (rtrner send!p, caller rcv!p, cst!p) ==> \
   17.52 +\        |- Calling send p & ~Calling rcv p & cst!p = #clkA  \
   17.53 +\           --> Enabled (MClkFwd send rcv cst p)"
   17.54     (fn _ => [action_simp_tac (simpset() addsimps [MClkFwd_def,Call_def,caller_def,rtrner_def])
   17.55                               [] [base_enabled,Pair_inject] 1]);
   17.56  
   17.57  qed_goal "MClkFwd_ch_enabled" MemClerk.thy
   17.58 -   "Enabled (MClkFwd send rcv cst p) s  \
   17.59 -\   ==> Enabled (<MClkFwd send rcv cst p>_<cst@p, rtrner send @ p, caller rcv @ p>) s"
   17.60 -   (fn [prem] => [auto_tac (claset() addSIs [prem RS enabled_mono],
   17.61 -			    simpset() addsimps [angle_def,MClkFwd_def])
   17.62 -		 ]);
   17.63 +   "|- Enabled (MClkFwd send rcv cst p)  -->  \
   17.64 +\      Enabled (<MClkFwd send rcv cst p>_(cst!p, rtrner send!p, caller rcv!p))"
   17.65 +   (fn _ => [auto_tac (mem_css addSEs2 [enabled_mono]
   17.66 +	                       addsimps2 [angle_def,MClkFwd_def])
   17.67 +  	    ]);
   17.68  
   17.69  qed_goal "MClkReply_change" MemClerk.thy
   17.70 -   "MClkReply send rcv cst p .-> <MClkReply send rcv cst p>_<cst@p, rtrner send @ p, caller rcv @ p>"
   17.71 -   (fn _ => [auto_tac (action_css addsimps2 [angle_def,MClkReply_def]
   17.72 -			          addEs2 [Return_changedE])
   17.73 +   "|- MClkReply send rcv cst p --> <MClkReply send rcv cst p>_(cst!p, rtrner send!p, caller rcv!p)"
   17.74 +   (fn _ => [auto_tac (mem_css addsimps2 [angle_def,MClkReply_def]
   17.75 +			       addEs2 [Return_changed])
   17.76              ]);
   17.77  
   17.78  qed_goal "MClkReply_enabled" MemClerk.thy
   17.79 -   "!!p. base_var <rtrner send @ p, caller rcv @ p, cst@p> ==> \
   17.80 -\        $(Calling send p) .& .~ $(Calling rcv p) .& ($(cst@p) .= #clkB)  \
   17.81 -\        .-> $(Enabled (<MClkReply send rcv cst p>_<cst@p, rtrner send @ p, caller rcv @ p>))"
   17.82 +   "!!p. basevars (rtrner send!p, caller rcv!p, cst!p) ==> \
   17.83 +\        |- Calling send p & ~Calling rcv p & cst!p = #clkB  \
   17.84 +\           --> Enabled (<MClkReply send rcv cst p>_(cst!p, rtrner send!p, caller rcv!p))"
   17.85     (fn _ => [action_simp_tac (simpset()) [MClkReply_change RSN (2,enabled_mono)] [] 1,
   17.86  	     action_simp_tac (simpset() addsimps [MClkReply_def,Return_def,caller_def,rtrner_def])
   17.87                               [] [base_enabled,Pair_inject] 1
   17.88  	    ]);
   17.89  
   17.90  qed_goal "MClkReplyNotRetry" MemClerk.thy
   17.91 -   "MClkReply send rcv cst p .-> .~(MClkRetry send rcv cst p)"
   17.92 -   (fn _ => [ auto_tac (claset(),
   17.93 -			simpset() addsimps [MClkReply_def,MClkRetry_def]) 
   17.94 -	    ]);
   17.95 +   "|- MClkReply send rcv cst p --> ~MClkRetry send rcv cst p"
   17.96 +   (fn _ => [ auto_tac (mem_css addsimps2 [MClkReply_def,MClkRetry_def]) ]);
   17.97 +
    18.1 --- a/src/HOL/TLA/Memory/MemClerk.thy	Mon Feb 08 13:02:42 1999 +0100
    18.2 +++ b/src/HOL/TLA/Memory/MemClerk.thy	Mon Feb 08 13:02:56 1999 +0100
    18.3 @@ -17,56 +17,53 @@
    18.4    mClkRcvChType = "rpcSndChType"
    18.5    mClkStType    = "(PrIds => mClkState) stfun"
    18.6  
    18.7 -consts
    18.8 +constdefs
    18.9    (* state predicates *)
   18.10    MClkInit      :: "mClkRcvChType => mClkStType => PrIds => stpred"
   18.11 +     "MClkInit rcv cst p == PRED (cst!p = #clkA  &  ~Calling rcv p)"
   18.12  
   18.13    (* actions *)
   18.14    MClkFwd       :: "mClkSndChType => mClkRcvChType => mClkStType => PrIds => action"
   18.15 +     "MClkFwd send rcv cst p == ACT
   18.16 +                           $Calling send p
   18.17 +                         & $(cst!p) = #clkA
   18.18 +                         & Call rcv p MClkRelayArg<arg<send!p>>
   18.19 +                         & (cst!p)$ = #clkB
   18.20 +                         & unchanged (rtrner send!p)"
   18.21 +
   18.22    MClkRetry     :: "mClkSndChType => mClkRcvChType => mClkStType => PrIds => action"
   18.23 +     "MClkRetry send rcv cst p == ACT
   18.24 +                           $(cst!p) = #clkB
   18.25 +                         & res<$(rcv!p)> = #RPCFailure
   18.26 +                         & Call rcv p MClkRelayArg<arg<send!p>>
   18.27 +                         & unchanged (cst!p, rtrner send!p)"
   18.28 +
   18.29    MClkReply     :: "mClkSndChType => mClkRcvChType => mClkStType => PrIds => action"
   18.30 +     "MClkReply send rcv cst p == ACT
   18.31 +                           ~$Calling rcv p
   18.32 +                         & $(cst!p) = #clkB
   18.33 +                         & Return send p MClkReplyVal<res<rcv!p>>
   18.34 +                         & (cst!p)$ = #clkA
   18.35 +                         & unchanged (caller rcv!p)"
   18.36 +
   18.37    MClkNext      :: "mClkSndChType => mClkRcvChType => mClkStType => PrIds => action"
   18.38 +      "MClkNext send rcv cst p == ACT
   18.39 +                        (  MClkFwd send rcv cst p
   18.40 +                         | MClkRetry send rcv cst p
   18.41 +                         | MClkReply send rcv cst p)"
   18.42 +
   18.43  
   18.44    (* temporal *)
   18.45    MClkIPSpec    :: "mClkSndChType => mClkRcvChType => mClkStType => PrIds => temporal"
   18.46 -  MClkISpec     :: "mClkSndChType => mClkRcvChType => mClkStType => temporal"
   18.47 -
   18.48 -rules
   18.49 -  MClkInit_def     "$(MClkInit rcv cst p) .=
   18.50 -                        ($(cst@p) .= #clkA  .&  .~ $(Calling rcv p))"
   18.51 -
   18.52 -  MClkFwd_def      "MClkFwd send rcv cst p ==
   18.53 -                        $(Calling send p)
   18.54 -                        .& $(cst@p) .= #clkA
   18.55 -                        .& Call rcv p (MClkRelayArg[ arg[$(send@p)] ])
   18.56 -                        .& (cst@p)$ .= #clkB
   18.57 -                        .& unchanged (rtrner send @ p)"
   18.58 -
   18.59 -  MClkRetry_def    "MClkRetry send rcv cst p ==
   18.60 -                        $(cst@p) .= #clkB
   18.61 -                        .& res[$(rcv@p)] .= #RPCFailure
   18.62 -                        .& Call rcv p (MClkRelayArg[ arg[$(send@p)] ])
   18.63 -                        .& unchanged <cst@p, rtrner send @ p>"
   18.64 +      "MClkIPSpec send rcv cst p == TEMP
   18.65 +                           Init MClkInit rcv cst p
   18.66 +                         & [][ MClkNext send rcv cst p ]_(cst!p, rtrner send!p, caller rcv!p)
   18.67 +                         & WF(MClkFwd send rcv cst p)_(cst!p, rtrner send!p, caller rcv!p)
   18.68 +                         & SF(MClkReply send rcv cst p)_(cst!p, rtrner send!p, caller rcv!p)"
   18.69  
   18.70 -  MClkReply_def    "MClkReply send rcv cst p ==
   18.71 -                        .~ $(Calling rcv p)
   18.72 -                        .& $(cst@p) .= #clkB
   18.73 -                        .& Return send p (MClkReplyVal[ res[$(rcv@p)] ])
   18.74 -                        .& (cst@p)$ .= #clkA
   18.75 -                        .& unchanged (caller rcv @ p)"
   18.76 +  MClkISpec     :: "mClkSndChType => mClkRcvChType => mClkStType => temporal"
   18.77 +      "MClkISpec send rcv cst == TEMP (!p. MClkIPSpec send rcv cst p)"
   18.78  
   18.79 -  MClkNext_def     "MClkNext send rcv cst p ==
   18.80 -                        MClkFwd send rcv cst p
   18.81 -                        .| MClkRetry send rcv cst p
   18.82 -                        .| MClkReply send rcv cst p"
   18.83 -
   18.84 -  MClkIPSpec_def   "MClkIPSpec send rcv cst p ==
   18.85 -                        Init($(MClkInit rcv cst p))
   18.86 -                        .& [][ MClkNext send rcv cst p ]_<cst@p, rtrner send @ p, caller rcv @ p>
   18.87 -                        .& WF(MClkFwd send rcv cst p)_<cst@p, rtrner send @ p, caller rcv @ p>
   18.88 -                        .& SF(MClkReply send rcv cst p)_<cst@p, rtrner send @ p, caller rcv @ p>"
   18.89 -
   18.90 -  MClkISpec_def    "MClkISpec send rcv cst == RALL p. MClkIPSpec send rcv cst p"
   18.91  end
   18.92  
   18.93  
    19.1 --- a/src/HOL/TLA/Memory/MemClerkParameters.ML	Mon Feb 08 13:02:42 1999 +0100
    19.2 +++ b/src/HOL/TLA/Memory/MemClerkParameters.ML	Mon Feb 08 13:02:56 1999 +0100
    19.3 @@ -6,6 +6,7 @@
    19.4      RPC-Memory example: Memory clerk parameters (ML file)
    19.5  *)
    19.6  
    19.7 +(*
    19.8  val CP_simps = RP_simps @ mClkState.simps;
    19.9  
   19.10 -
   19.11 +*)
    20.1 --- a/src/HOL/TLA/Memory/MemClerkParameters.thy	Mon Feb 08 13:02:42 1999 +0100
    20.2 +++ b/src/HOL/TLA/Memory/MemClerkParameters.thy	Mon Feb 08 13:02:56 1999 +0100
    20.3 @@ -16,19 +16,16 @@
    20.4  types
    20.5    (* types sent on the clerk's send and receive channels are argument types
    20.6       of the memory and the RPC, respectively *)
    20.7 -  mClkSndArgType   = "memArgType"
    20.8 -  mClkRcvArgType   = "rpcArgType"
    20.9 +  mClkSndArgType   = "memOp"
   20.10 +  mClkRcvArgType   = "rpcOp"
   20.11  
   20.12 -consts
   20.13 +constdefs
   20.14    (* translate a memory call to an RPC call *)
   20.15 -  MClkRelayArg     :: "memArgType => rpcArgType"
   20.16 +  MClkRelayArg     :: "memOp => rpcOp"
   20.17 +    "MClkRelayArg marg == memcall marg"
   20.18    (* translate RPC failures to memory failures *)
   20.19    MClkReplyVal     :: "Vals => Vals"
   20.20 -
   20.21 -rules
   20.22 -  MClkRelayArg_def    "MClkRelayArg marg == Inl (remoteCall, marg)"
   20.23 -  MClkReplyVal_def    "MClkReplyVal v == 
   20.24 -                           if v = RPCFailure then MemFailure else v"
   20.25 +    "MClkReplyVal v == if v = RPCFailure then MemFailure else v"
   20.26  
   20.27  end
   20.28  
    21.1 --- a/src/HOL/TLA/Memory/Memory.ML	Mon Feb 08 13:02:42 1999 +0100
    21.2 +++ b/src/HOL/TLA/Memory/Memory.ML	Mon Feb 08 13:02:56 1999 +0100
    21.3 @@ -3,49 +3,45 @@
    21.4      Author:      Stephan Merz
    21.5      Copyright:   1997 University of Munich
    21.6  
    21.7 -    RPC-Memory example: Memory specification (ML file)
    21.8 +    RPC-Memory example: Memory specification (theorems and proofs)
    21.9  *)
   21.10  
   21.11  val RM_action_defs = 
   21.12 -   (map (fn t => t RS inteq_reflection)
   21.13 -        [MInit_def, PInit_def, RdRequest_def, WrRequest_def, MemInv_def])
   21.14 -   @ [GoodRead_def, BadRead_def, ReadInner_def, Read_def,
   21.15 -      GoodWrite_def, BadWrite_def, WriteInner_def, Write_def,
   21.16 -      MemReturn_def, RNext_def];
   21.17 +   [MInit_def, PInit_def, RdRequest_def, WrRequest_def, MemInv_def,
   21.18 +    GoodRead_def, BadRead_def, ReadInner_def, Read_def,
   21.19 +    GoodWrite_def, BadWrite_def, WriteInner_def, Write_def,
   21.20 +    MemReturn_def, RNext_def];
   21.21  
   21.22  val UM_action_defs = RM_action_defs @ [MemFail_def, UNext_def];
   21.23  
   21.24  val RM_temp_defs = [RPSpec_def, MSpec_def, IRSpec_def];
   21.25  val UM_temp_defs = [UPSpec_def, MSpec_def, IUSpec_def];
   21.26  
   21.27 -(* Make sure the simpset accepts non-boolean simplifications *)
   21.28 -simpset_ref() := simpset() setmksimps ((mksimps mksimps_pairs) o maybe_unlift);
   21.29 +val mem_css = (claset(), simpset());
   21.30  
   21.31  (* -------------------- Proofs ---------------------------------------------- *)
   21.32  
   21.33  (* The reliable memory is an implementation of the unreliable one *)
   21.34  qed_goal "ReliableImplementsUnReliable" Memory.thy 
   21.35 -   "IRSpec ch mm rs .-> IUSpec ch mm rs"
   21.36 -   (K [force_tac (temp_css addsimps2 ([square_def,UNext_def] @ 
   21.37 -			RM_temp_defs @ UM_temp_defs) addSEs2 [STL4E]) 1]);
   21.38 +   "|- IRSpec ch mm rs --> IUSpec ch mm rs"
   21.39 +   (K [force_tac (temp_css addsimps2 ([UNext_def,UPSpec_def,IUSpec_def] @ RM_temp_defs)
   21.40 +			   addSEs2 [STL4E,squareE]) 1]);
   21.41  
   21.42  (* The memory spec implies the memory invariant *)
   21.43  qed_goal "MemoryInvariant" Memory.thy 
   21.44 -   "(MSpec ch mm rs l) .-> []($(MemInv mm l))"
   21.45 -   (fn _ => [ auto_inv_tac (simpset() addsimps RM_temp_defs @ 
   21.46 -					MP_simps @ RM_action_defs) 1 ]);
   21.47 +   "|- MSpec ch mm rs l --> [](MemInv mm l)"
   21.48 +   (fn _ => [ auto_inv_tac (simpset() addsimps RM_temp_defs @ RM_action_defs) 1 ]);
   21.49  
   21.50  (* The invariant is trivial for non-locations *)
   21.51  qed_goal "NonMemLocInvariant" Memory.thy
   21.52 -   ".~ #(MemLoc l) .-> []($MemInv mm l)"
   21.53 -   (K [ auto_tac (temp_css addsimps2 [MemInv_def] addSIs2 [necT RS tempD]) ]);
   21.54 +   "|- #l ~: #MemLoc --> [](MemInv mm l)"
   21.55 +   (K [ auto_tac (temp_css addsimps2 [MemInv_def] addSIs2 [necT]) ]);
   21.56  
   21.57  qed_goal "MemoryInvariantAll" Memory.thy
   21.58 -   "((RALL l. #(MemLoc l) .-> MSpec ch mm rs l)) .-> (RALL l. []($MemInv mm l))"
   21.59 +   "|- (!l. #l : #MemLoc --> MSpec ch mm rs l) --> (!l. [](MemInv mm l))"
   21.60      (K [step_tac temp_cs 1,
   21.61 -	case_tac "MemLoc l" 1,
   21.62 -	auto_tac (temp_css addSEs2 (map temp_mp [MemoryInvariant,
   21.63 -			NonMemLocInvariant]))]);
   21.64 +	case_tac "l : MemLoc" 1,
   21.65 +	auto_tac (temp_css addSEs2 [MemoryInvariant,NonMemLocInvariant]) ]);
   21.66  
   21.67  (* The memory engages in an action for process p only if there is an 
   21.68     unanswered call from p.
   21.69 @@ -53,35 +49,28 @@
   21.70  *)
   21.71  
   21.72  qed_goal "Memoryidle" Memory.thy
   21.73 -   ".~ $(Calling ch p) .-> .~ RNext ch mm rs p"
   21.74 -   (K [ auto_tac (action_css addsimps2 (RM_action_defs @ [Return_def])) ]);
   21.75 -
   21.76 -bind_thm("MemoryidleI", action_mp Memoryidle);
   21.77 -bind_thm("MemoryidleE", action_impE Memoryidle);
   21.78 -
   21.79 +   "|- ~$(Calling ch p) --> ~ RNext ch mm rs p"
   21.80 +   (K [ auto_tac (mem_css addsimps2 (Return_def::RM_action_defs)) ]);
   21.81  
   21.82  (* Enabledness conditions *)
   21.83  
   21.84  qed_goal "MemReturn_change" Memory.thy
   21.85 -   "MemReturn ch rs p .-> <MemReturn ch rs p>_<rtrner ch @ p, rs@p>"
   21.86 -   (K [ force_tac (action_css addsimps2 [MemReturn_def,angle_def]) 1]);
   21.87 +   "|- MemReturn ch rs p --> <MemReturn ch rs p>_(rtrner ch ! p, rs!p)"
   21.88 +   (K [ force_tac (mem_css addsimps2 [MemReturn_def,angle_def]) 1]);
   21.89  
   21.90  qed_goal "MemReturn_enabled" Memory.thy
   21.91 -   "!!p. base_var <rtrner ch @ p, rs@p> ==> \
   21.92 -\        $(Calling ch p) .& ($(rs@p) .~= #NotAResult) \
   21.93 -\        .-> $(Enabled (<MemReturn ch rs p>_<rtrner ch @ p, rs@p>))"
   21.94 +   "!!p. basevars (rtrner ch ! p, rs!p) ==> \
   21.95 +\        |- Calling ch p & (rs!p ~= #NotAResult) \
   21.96 +\           --> Enabled (<MemReturn ch rs p>_(rtrner ch ! p, rs!p))"
   21.97    (K [action_simp_tac (simpset()) [MemReturn_change RSN (2,enabled_mono)] [] 1,
   21.98        action_simp_tac (simpset() addsimps [MemReturn_def,Return_def,rtrner_def])
   21.99                               [] [base_enabled,Pair_inject] 1
  21.100  	    ]);
  21.101  
  21.102  qed_goal "ReadInner_enabled" Memory.thy
  21.103 -   "!!p. base_var <rtrner ch @ p, rs@p> ==> \
  21.104 -\        $(Calling ch p) .& (arg[$(ch@p)] .= #(Inl (read,l))) \
  21.105 -\        .-> $(Enabled (ReadInner ch mm rs p l))"
  21.106 -   (fn _ => [Action_simp_tac 1,
  21.107 -(* unlift before applying case_tac: case_split_thm expects boolean conclusion *)
  21.108 -	     case_tac "MemLoc l" 1,
  21.109 + "!!p. basevars (rtrner ch ! p, rs!p) ==> \
  21.110 +\      |- Calling ch p & (arg<ch!p> = #(read l)) --> Enabled (ReadInner ch mm rs p l)"
  21.111 +   (fn _ => [case_tac "l : MemLoc" 1,
  21.112               ALLGOALS
  21.113  	        (action_simp_tac 
  21.114                      (simpset() addsimps [ReadInner_def,GoodRead_def,BadRead_def,
  21.115 @@ -90,11 +79,10 @@
  21.116              ]);
  21.117  
  21.118  qed_goal "WriteInner_enabled" Memory.thy
  21.119 -   "!!p. base_var <rtrner ch @ p, mm@l, rs@p> ==> \
  21.120 -\        $(Calling ch p) .& (arg[$(ch@p)] .= #(Inr (write,l,v))) \
  21.121 -\        .-> $(Enabled (WriteInner ch mm rs p l v))"
  21.122 -   (fn _ => [Action_simp_tac 1,
  21.123 -	     case_tac "MemLoc l & MemVal v" 1,
  21.124 +   "!!p. basevars (mm!l, rtrner ch ! p, rs!p) ==> \
  21.125 +\        |- Calling ch p & (arg<ch!p> = #(write l v)) \
  21.126 +\           --> Enabled (WriteInner ch mm rs p l v)"
  21.127 +   (fn _ => [case_tac "l:MemLoc & v:MemVal" 1,
  21.128               ALLGOALS (action_simp_tac 
  21.129                   (simpset() addsimps [WriteInner_def,GoodWrite_def,BadWrite_def,
  21.130  					WrRequest_def] delsimps [disj_not1])
  21.131 @@ -102,57 +90,45 @@
  21.132              ]);
  21.133  
  21.134  qed_goal "ReadResult" Memory.thy
  21.135 -   "(Read ch mm rs p) .& (RALL l. $(MemInv mm l)) .-> (rs@p)$ .~= #NotAResult"
  21.136 -   (fn _ => [action_simp_tac 
  21.137 -               (simpset() addsimps (MP_simps 
  21.138 -				   @ [Read_def,ReadInner_def,GoodRead_def,
  21.139 -				      BadRead_def,MemInv_def]))
  21.140 -	       [] [] 1,
  21.141 -	     auto_tac (action_css addsimps2 MP_simps) ]);
  21.142 +   "|- Read ch mm rs p & (!l. $(MemInv mm l)) --> (rs!p)` ~= #NotAResult"
  21.143 +   (fn _ => [force_tac (mem_css addsimps2 
  21.144 +                            [Read_def,ReadInner_def,GoodRead_def,BadRead_def,MemInv_def]) 1]);
  21.145  
  21.146  qed_goal "WriteResult" Memory.thy
  21.147 -   "(Write ch mm rs p l) .-> (rs@p)$ .~= #NotAResult"
  21.148 -   (fn _ => [auto_tac (claset(),
  21.149 -		       simpset() addsimps (MP_simps @
  21.150 -		   [Write_def,WriteInner_def,GoodWrite_def,BadWrite_def]))
  21.151 +   "|- Write ch mm rs p l --> (rs!p)` ~= #NotAResult"
  21.152 +   (fn _ => [auto_tac (mem_css addsimps2 ([Write_def,WriteInner_def,GoodWrite_def,BadWrite_def]))
  21.153  	    ]);
  21.154  
  21.155  qed_goal "ReturnNotReadWrite" Memory.thy
  21.156 -   "(RALL l. $MemInv mm l) .& (MemReturn ch rs p) \
  21.157 -\   .-> .~(Read ch mm rs p) .& (RALL l. .~(Write ch mm rs p l))"
  21.158 +   "|- (!l. $MemInv mm l) & MemReturn ch rs p \
  21.159 +\      --> ~ Read ch mm rs p & (!l. ~ Write ch mm rs p l)"
  21.160     (fn _ => [auto_tac
  21.161 -	       (action_css addsimps2 [MemReturn_def]
  21.162 -	          addSEs2 [action_impE WriteResult,action_conjimpE ReadResult])
  21.163 +	       (mem_css addsimps2 [MemReturn_def] addSDs2 [WriteResult, ReadResult])
  21.164  	    ]);
  21.165  
  21.166  qed_goal "RWRNext_enabled" Memory.thy
  21.167 -   "($(rs@p) .= #NotAResult) .& (RALL l. $(MemInv mm l))  \
  21.168 -\      .& $(Enabled (Read ch mm rs p .| (REX l. Write ch mm rs p l))) \
  21.169 -\   .-> $(Enabled (<RNext ch mm rs p>_<rtrner ch @ p, rs@p>))"
  21.170 -   (K [force_tac (action_css addsimps2 [RNext_def,angle_def]
  21.171 +   "|- (rs!p = #NotAResult) & (!l. MemInv mm l)  \
  21.172 +\          & Enabled (Read ch mm rs p | (? l. Write ch mm rs p l)) \
  21.173 +\      --> Enabled (<RNext ch mm rs p>_(rtrner ch ! p, rs!p))"
  21.174 +   (K [force_tac (mem_css addsimps2 [RNext_def,angle_def]
  21.175  	     addSEs2 [enabled_mono2]
  21.176 -	     addEs2[action_conjimpE ReadResult,action_impE WriteResult]) 1]);
  21.177 +	     addDs2 [ReadResult, WriteResult]) 1]);
  21.178  
  21.179  
  21.180  (* Combine previous lemmas: the memory can make a visible step if there is an
  21.181     outstanding call for which no result has been produced.
  21.182  *)
  21.183  qed_goal "RNext_enabled" Memory.thy
  21.184 -"!!p. (ALL l. base_var <rtrner ch @ p, mm@l, rs@p>) ==> \
  21.185 -\     ($(rs@p) .= #NotAResult) .& $(Calling ch p) .& (RALL l. $(MemInv mm l))  \
  21.186 -\        .-> $(Enabled (<RNext ch mm rs p>_<rtrner ch @ p, rs@p>))" (K [
  21.187 -	     auto_tac (action_css addsimps2 [enabled_disj]
  21.188 -		                  addSIs2 [action_mp RWRNext_enabled]),
  21.189 -	     res_inst_tac [("s","arg(ch s p)")] sumE 1,
  21.190 -	      action_simp_tac (simpset()addsimps[Read_def,enabled_ex,base_pair])
  21.191 -	                      [action_mp ReadInner_enabled,exI] [] 1,
  21.192 -	      split_all_tac 1, rename_tac "a b" 1, induct_tac "a" 1,
  21.193 -	     (* introduce a trivial subgoal to solve flex-flex constraint?! *)
  21.194 -	      subgoal_tac "b = snd(a,b)" 1,
  21.195 -	       TRYALL Simp_tac,  (* solves "read" case *)
  21.196 +"!!p. !l. basevars (mm!l, rtrner ch!p, rs!p) ==> \
  21.197 +\     |- (rs!p = #NotAResult) & Calling ch p & (!l. MemInv mm l)  \
  21.198 +\        --> Enabled (<RNext ch mm rs p>_(rtrner ch ! p, rs!p))" (K [
  21.199 +	     auto_tac (mem_css addsimps2 [enabled_disj]
  21.200 +		                  addSIs2 [RWRNext_enabled]),
  21.201 +             exhaust_tac "arg(ch w p)" 1,
  21.202 + 	      action_simp_tac (simpset()addsimps[Read_def,enabled_ex])
  21.203 +	                      [ReadInner_enabled,exI] [] 1,
  21.204 +              force_tac (mem_css addDs2 [base_pair]) 1,
  21.205  	     etac swap 1,
  21.206 -	     action_simp_tac (simpset()addsimps[Write_def,enabled_ex,base_pair])
  21.207 -	                     [action_mp WriteInner_enabled,exI] [] 1,
  21.208 -	     split_all_tac 1, rename_tac "a aa b" 1, induct_tac "a" 1,
  21.209 -	     subgoal_tac "(aa = fst(snd(a,aa,b))) & (b = snd(snd(a,aa,b)))" 1,
  21.210 -	     ALLGOALS Simp_tac ]);
  21.211 +	     action_simp_tac (simpset() addsimps [Write_def,enabled_ex])
  21.212 +	                     [WriteInner_enabled,exI] [] 1]);
  21.213 +
    22.1 --- a/src/HOL/TLA/Memory/Memory.thy	Mon Feb 08 13:02:42 1999 +0100
    22.2 +++ b/src/HOL/TLA/Memory/Memory.thy	Mon Feb 08 13:02:56 1999 +0100
    22.3 @@ -12,7 +12,7 @@
    22.4  Memory = MemoryParameters + ProcedureInterface +
    22.5  
    22.6  types
    22.7 -  memChType  = "(memArgType,Vals) channel"
    22.8 +  memChType  = "(memOp, Vals) channel"
    22.9    memType = "(Locs => Vals) stfun"      (* intention: MemLocs => MemVals *)
   22.10    resType = "(PrIds => Vals) stfun"
   22.11  
   22.12 @@ -55,82 +55,83 @@
   22.13    MemInv    :: "memType => Locs => stpred"
   22.14  
   22.15  rules
   22.16 -  MInit_def         "$(MInit mm l) .= ($(mm@l) .= # InitVal)"
   22.17 -  PInit_def         "$(PInit rs p) .= ($(rs@p) .= # NotAResult)"
   22.18 +  MInit_def         "MInit mm l == PRED mm!l = #InitVal"
   22.19 +  PInit_def         "PInit rs p == PRED rs!p = #NotAResult"
   22.20  
   22.21 -  RdRequest_def     "$(RdRequest ch p l) .= 
   22.22 -                         ($(Calling ch p) .& (arg[$(ch@p)] .= #(Inl (read,l))))"
   22.23 -  WrRequest_def     "$(WrRequest ch p l v) .=
   22.24 -                         ($(Calling ch p) .& (arg[$(ch@p)] .= #(Inr (write,l,v))))"
   22.25 +  RdRequest_def     "RdRequest ch p l == PRED
   22.26 +                         Calling ch p & (arg<ch!p> = #(read l))"
   22.27 +  WrRequest_def     "WrRequest ch p l v == PRED
   22.28 +                         Calling ch p & (arg<ch!p> = #(write l v))"
   22.29    (* a read that doesn't raise BadArg *)
   22.30 -  GoodRead_def      "GoodRead mm rs p l ==
   22.31 -                        #(MemLoc l) .& (rs@p)$ .= $(mm@l)"
   22.32 +  GoodRead_def      "GoodRead mm rs p l == ACT
   22.33 +                        #l : #MemLoc & ((rs!p)$ = $(mm!l))"
   22.34    (* a read that raises BadArg *)
   22.35 -  BadRead_def       "BadRead mm rs p l ==
   22.36 -                        .~ #(MemLoc l) .& (rs@p)$ .= #BadArg"
   22.37 +  BadRead_def       "BadRead mm rs p l == ACT
   22.38 +                        #l ~: #MemLoc & ((rs!p)$ = #BadArg)"
   22.39    (* the read action with l visible *)
   22.40 -  ReadInner_def     "ReadInner ch mm rs p l ==
   22.41 +  ReadInner_def     "ReadInner ch mm rs p l == ACT
   22.42                           $(RdRequest ch p l)
   22.43 -                         .& (GoodRead mm rs p l  .|  BadRead mm rs p l)
   22.44 -                         .& unchanged (rtrner ch @ p)"
   22.45 +                         & (GoodRead mm rs p l  |  BadRead mm rs p l)
   22.46 +                         & unchanged (rtrner ch ! p)"
   22.47    (* the read action with l quantified *)
   22.48 -  Read_def          "Read ch mm rs p == REX l. ReadInner ch mm rs p l"
   22.49 +  Read_def          "Read ch mm rs p == ACT (? l. ReadInner ch mm rs p l)"
   22.50  
   22.51    (* similar definitions for the write action *)
   22.52 -  GoodWrite_def     "GoodWrite mm rs p l v ==
   22.53 -                        #(MemLoc l) .& #(MemVal v) 
   22.54 -                        .& (mm@l)$ .= #v .& (rs@p)$ .= #OK"
   22.55 -  BadWrite_def      "BadWrite mm rs p l v ==
   22.56 -                        .~ (#(MemLoc l) .& #(MemVal v))
   22.57 -                        .& (rs@p)$ .= #BadArg .& unchanged (mm@l)"
   22.58 -  WriteInner_def    "WriteInner ch mm rs p l v ==
   22.59 +  GoodWrite_def     "GoodWrite mm rs p l v == ACT
   22.60 +                        #l : #MemLoc & #v : #MemVal
   22.61 +                        & ((mm!l)$ = #v) & ((rs!p)$ = #OK)"
   22.62 +  BadWrite_def      "BadWrite mm rs p l v == ACT
   22.63 +                        ~ (#l : #MemLoc & #v : #MemVal)
   22.64 +                        & ((rs!p)$ = #BadArg) & unchanged (mm!l)"
   22.65 +  WriteInner_def    "WriteInner ch mm rs p l v == ACT
   22.66                          $(WrRequest ch p l v)
   22.67 -                        .& (GoodWrite mm rs p l v  .|  BadWrite mm rs p l v)
   22.68 -                        .& unchanged (rtrner ch @ p)"
   22.69 -  Write_def         "Write ch mm rs p l == REX v. WriteInner ch mm rs p l v"
   22.70 +                        & (GoodWrite mm rs p l v  |  BadWrite mm rs p l v)
   22.71 +                        & unchanged (rtrner ch ! p)"
   22.72 +  Write_def         "Write ch mm rs p l == ACT (? v. WriteInner ch mm rs p l v)"
   22.73  
   22.74    (* the return action *)
   22.75 -  MemReturn_def     "MemReturn ch rs p ==
   22.76 -                        $(rs@p) .~= #NotAResult
   22.77 -                        .& (rs@p)$ .= #NotAResult
   22.78 -                        .& Return ch p ($(rs@p))"
   22.79 +  MemReturn_def     "MemReturn ch rs p == ACT
   22.80 +                       (   ($(rs!p) ~= #NotAResult)
   22.81 +                        & ((rs!p)$ = #NotAResult)
   22.82 +                        & Return ch p (rs!p))"
   22.83 +
   22.84    (* the failure action of the unreliable memory *)
   22.85 -  MemFail_def       "MemFail ch rs p ==
   22.86 +  MemFail_def       "MemFail ch rs p == ACT
   22.87                          $(Calling ch p)
   22.88 -                        .& (rs@p)$ .= #MemFailure
   22.89 -                        .& unchanged (rtrner ch @ p)"
   22.90 -  RNext_def         "RNext ch mm rs p ==
   22.91 -                        Read ch mm rs p
   22.92 -                        .| (REX l. Write ch mm rs p l)
   22.93 -                        .| MemReturn ch rs p"
   22.94 -  UNext_def         "UNext ch mm rs p ==
   22.95 -                        RNext ch mm rs p .| MemFail ch rs p"
   22.96 +                        & ((rs!p)$ = #MemFailure)
   22.97 +                        & unchanged (rtrner ch ! p)"
   22.98 +  (* next-state relations for reliable / unreliable memory *)
   22.99 +  RNext_def         "RNext ch mm rs p == ACT 
  22.100 +                       (  Read ch mm rs p
  22.101 +                        | (? l. Write ch mm rs p l)
  22.102 +                        | MemReturn ch rs p)"
  22.103 +  UNext_def         "UNext ch mm rs p == ACT
  22.104 +                        (RNext ch mm rs p | MemFail ch rs p)"
  22.105  
  22.106 -  RPSpec_def        "RPSpec ch mm rs p ==
  22.107 -                        Init($(PInit rs p))
  22.108 -                        .& [][ RNext ch mm rs p ]_<rtrner ch @ p, rs@p>
  22.109 -                        .& WF(RNext ch mm rs p)_<rtrner ch @ p, rs@p>
  22.110 -                        .& WF(MemReturn ch rs p)_<rtrner ch @ p, rs@p>"
  22.111 -  UPSpec_def        "UPSpec ch mm rs p ==
  22.112 -                        Init($(PInit rs p))
  22.113 -                        .& [][ UNext ch mm rs p ]_<rtrner ch @ p, rs@p>
  22.114 -                        .& WF(RNext ch mm rs p)_<rtrner ch @ p, rs@p>
  22.115 -                        .& WF(MemReturn ch rs p)_<rtrner ch @ p, rs@p>"
  22.116 -  MSpec_def         "MSpec ch mm rs l ==
  22.117 -                        Init($(MInit mm l))
  22.118 -                        .& [][ REX p. Write ch mm rs p l ]_(mm@l)"
  22.119 -  IRSpec_def        "IRSpec ch mm rs ==
  22.120 -                        (RALL p. RPSpec ch mm rs p)
  22.121 -                        .& (RALL l. #(MemLoc l) .-> MSpec ch mm rs l)"
  22.122 -  IUSpec_def        "IUSpec ch mm rs ==
  22.123 -                        (RALL p. UPSpec ch mm rs p)
  22.124 -                        .& (RALL l. #(MemLoc l) .-> MSpec ch mm rs l)"
  22.125 +  RPSpec_def        "RPSpec ch mm rs p == TEMP
  22.126 +                        Init(PInit rs p)
  22.127 +                        & [][ RNext ch mm rs p ]_(rtrner ch ! p, rs!p)
  22.128 +                        & WF(RNext ch mm rs p)_(rtrner ch ! p, rs!p)
  22.129 +                        & WF(MemReturn ch rs p)_(rtrner ch ! p, rs!p)"
  22.130 +  UPSpec_def        "UPSpec ch mm rs p == TEMP
  22.131 +                        Init(PInit rs p)
  22.132 +                        & [][ UNext ch mm rs p ]_(rtrner ch ! p, rs!p)
  22.133 +                        & WF(RNext ch mm rs p)_(rtrner ch ! p, rs!p)
  22.134 +                        & WF(MemReturn ch rs p)_(rtrner ch ! p, rs!p)"
  22.135 +  MSpec_def         "MSpec ch mm rs l == TEMP
  22.136 +                        Init(MInit mm l)
  22.137 +                        & [][ ? p. Write ch mm rs p l ]_(mm!l)"
  22.138 +  IRSpec_def        "IRSpec ch mm rs == TEMP
  22.139 +                        (! p. RPSpec ch mm rs p)
  22.140 +                        & (! l. #l : #MemLoc --> MSpec ch mm rs l)"
  22.141 +  IUSpec_def        "IUSpec ch mm rs == TEMP
  22.142 +                        (! p. UPSpec ch mm rs p)
  22.143 +                        & (! l. #l : #MemLoc --> MSpec ch mm rs l)"
  22.144  
  22.145 -  RSpec_def         "RSpec ch rs == EEX mm. IRSpec ch mm rs"
  22.146 -  USpec_def         "USpec ch == EEX mm rs. IUSpec ch mm rs"
  22.147 +  RSpec_def         "RSpec ch rs == TEMP (EEX mm. IRSpec ch mm rs)"
  22.148 +  USpec_def         "USpec ch == TEMP (EEX mm rs. IUSpec ch mm rs)"
  22.149  
  22.150 -  MemInv_def        "$(MemInv mm l) .=
  22.151 -                        (#(MemLoc l) .-> MemVal[ $(mm@l)])"
  22.152 +  MemInv_def        "MemInv mm l == PRED  #l : #MemLoc --> mm!l : #MemVal"
  22.153  end
  22.154  
  22.155  
    23.1 --- a/src/HOL/TLA/Memory/MemoryImplementation.ML	Mon Feb 08 13:02:42 1999 +0100
    23.2 +++ b/src/HOL/TLA/Memory/MemoryImplementation.ML	Mon Feb 08 13:02:56 1999 +0100
    23.3 @@ -13,90 +13,50 @@
    23.4      Steps are (roughly) numbered as in the hand proof.
    23.5  *)
    23.6  
    23.7 -
    23.8 -(* ------------------------------ HOL lemmas ------------------------------ *)
    23.9 -(* Add the following simple lemmas as default simplification rules. *)
   23.10 -
   23.11 -section "Auxiliary lemmas";
   23.12 -
   23.13 -qed_goal "equal_false_not" HOL.thy "(P = False) = (~P)"
   23.14 -   (fn _ => [fast_tac prop_cs 1]);
   23.15 -
   23.16 -Addsimps [equal_false_not];
   23.17 -
   23.18 -
   23.19 -(* A variant of the implication elimination rule that keeps the antecedent.
   23.20 -   Use "thm RS impdupE" to generate an unsafe (looping) elimination rule. 
   23.21 -*)
   23.22 -
   23.23 -qed_goal "impdupE" HOL.thy
   23.24 -   "[| P --> Q; P; [| P;Q |] ==> R |] ==> R"
   23.25 -   (fn maj::prems => [REPEAT (resolve_tac ([maj RS mp] @ prems) 1)]);
   23.26 +(* --------------------------- automatic prover --------------------------- *)
   23.27  
   23.28 -
   23.29 -(* Introduction/elimination rules for if-then-else *)
   23.30 -
   23.31 -qed_goal "ifI" HOL.thy 
   23.32 -   "[| Q ==> P(x); ~Q ==> P(y) |] ==> P(if Q then x else y)"
   23.33 -   (fn prems => [case_tac "Q" 1, ALLGOALS (Asm_simp_tac THEN' (eresolve_tac prems))]);
   23.34 -
   23.35 -qed_goal "ifE" HOL.thy
   23.36 -   "[| P(if Q then x else y); [| Q; P(x) |] ==> R; [| ~Q; P(y) |] ==> R |] ==> R"
   23.37 -   (fn (prem1::prems) => [case_tac "Q" 1,
   23.38 -                          ALLGOALS ((cut_facts_tac [prem1])
   23.39 -                                    THEN' Asm_full_simp_tac 
   23.40 -                                    THEN' (REPEAT o ((eresolve_tac prems) ORELSE' atac)))
   23.41 -                         ]);
   23.42 -
   23.43 -(* --------------------------- automatic prover --------------------------- *)
   23.44 -(* Set up a clasimpset that contains data-level simplifications. *)
   23.45 -
   23.46 -val MI_css = temp_css addsimps2 (CP_simps @ histState.simps
   23.47 -                                 @ [slice_def,equal_false_not,if_cancel,sum_case_Inl, sum_case_Inr]);
   23.48 +val MI_css = (claset(), simpset());
   23.49  
   23.50  (* A more aggressive variant that tries to solve subgoals by assumption
   23.51     or contradiction during the simplification.
   23.52     THIS IS UNSAFE, BECAUSE IT DOESN'T RECORD THE CHOICES!!
   23.53 -   (but sometimes a lot faster than MI_css)
   23.54 +   (but it can be a lot faster than MI_css)
   23.55  *)
   23.56  val MI_fast_css =
   23.57    let 
   23.58      val (cs,ss) = MI_css
   23.59    in
   23.60 -    (cs, ss addSSolver (fn thms => assume_tac ORELSE' (etac notE)))
   23.61 +    (cs addSEs [squareE], ss addSSolver (fn thms => assume_tac ORELSE' (etac notE)))
   23.62  end;
   23.63  
   23.64 -(* Make sure the simpset accepts non-boolean simplifications *)
   23.65 -simpset_ref() := let val (_,ss) = MI_css in ss end;
   23.66 -
   23.67 +val temp_elim = make_elim o temp_use;
   23.68  
   23.69  (****************************** The history variable ******************************)
   23.70  section "History variable";
   23.71  
   23.72  qed_goal "HistoryLemma" MemoryImplementation.thy
   23.73 -   "Init(RALL p. $(ImpInit p)) .& [](RALL p. ImpNext p)  \
   23.74 -\   .-> (EEX rmhist.    Init(RALL p. $(HInit rmhist p)) \
   23.75 -\                    .& [](RALL p. [HNext rmhist p]_<c p, r p, m p, rmhist@p>))"
   23.76 -   (fn _ => [Auto_tac,
   23.77 -             rtac historyI 1, TRYALL atac,
   23.78 +   "|- Init(!p. ImpInit p) & [](!p. ImpNext p)  \
   23.79 +\      --> (EEX rmhist. Init(! p. HInit rmhist p) \
   23.80 +\                     & [](!p. [HNext rmhist p]_(c p, r p, m p, rmhist!p)))"
   23.81 +   (fn _ => [Clarsimp_tac 1,
   23.82 +             rtac historyI 1, TRYALL atac, rtac MI_base 1,
   23.83               action_simp_tac (simpset() addsimps [HInit_def]) [] [] 1,
   23.84 -             res_inst_tac [("x","p")] fun_cong 1, atac 1,
   23.85 +             etac fun_cong 1,
   23.86               action_simp_tac (simpset() addsimps [HNext_def]) [busy_squareI] [] 1,
   23.87 -             res_inst_tac [("x","p")] fun_cong 1, atac 1
   23.88 +             etac fun_cong 1
   23.89              ]);
   23.90  
   23.91  qed_goal "History" MemoryImplementation.thy
   23.92 -   "Implementation .-> (EEX rmhist. Hist rmhist)"
   23.93 -   (fn _ => [Auto_tac,
   23.94 -             rtac ((temp_mp HistoryLemma) RS eex_mono) 1,
   23.95 -             SELECT_GOAL 
   23.96 -               (auto_tac (MI_css 
   23.97 -                          addsimps2 [Impl_def,MClkISpec_def,RPCISpec_def,IRSpec_def,
   23.98 -                                     MClkIPSpec_def,RPCIPSpec_def,RPSpec_def,
   23.99 -                                     ImpInit_def,Init_def,ImpNext_def,
  23.100 -                                     c_def,r_def,m_def,all_box,split_box_conj])) 1,
  23.101 -             auto_tac (MI_css 
  23.102 -                       addsimps2 [Hist_def,HistP_def,Init_def,all_box,split_box_conj])
  23.103 +   "|- Implementation --> (EEX rmhist. Hist rmhist)"
  23.104 +   (fn _ => [Clarsimp_tac 1,
  23.105 +             rtac ((temp_use HistoryLemma) RS eex_mono) 1,
  23.106 +             force_tac (MI_css 
  23.107 +                        addsimps2 [Hist_def,HistP_def,Init_def,all_box,split_box_conj]) 3,
  23.108 +             auto_tac (MI_css
  23.109 +                       addsimps2 [Implementation_def,MClkISpec_def,RPCISpec_def,IRSpec_def,
  23.110 +                                  MClkIPSpec_def,RPCIPSpec_def,RPSpec_def,
  23.111 +                                  ImpInit_def,Init_def,ImpNext_def,
  23.112 +                                  c_def,r_def,m_def,all_box,split_box_conj])
  23.113              ]);
  23.114  
  23.115  (******************************** The safety part *********************************)
  23.116 @@ -108,11 +68,12 @@
  23.117  
  23.118  section "Correctness of predicate-action diagram";
  23.119  
  23.120 +
  23.121  (* ========== Step 1.1 ================================================= *)
  23.122  (* The implementation's initial condition implies the state predicate S1 *)
  23.123  
  23.124  qed_goal "Step1_1" MemoryImplementation.thy
  23.125 -   "$(ImpInit p) .& $(HInit rmhist p) .-> $(S1 rmhist p)"
  23.126 +   "|- ImpInit p & HInit rmhist p --> S1 rmhist p"
  23.127     (fn _ => [auto_tac (MI_fast_css
  23.128  		       addsimps2 [MVNROKBA_def,MClkInit_def,RPCInit_def,PInit_def,
  23.129  			          HInit_def,ImpInit_def,S_def,S1_def])
  23.130 @@ -122,84 +83,81 @@
  23.131  (* Figure 16 is a predicate-action diagram for the implementation. *)
  23.132  
  23.133  qed_goal "Step1_2_1" MemoryImplementation.thy
  23.134 -   "[HNext rmhist p]_<c p,r p,m p, rmhist@p> .& ImpNext p  \
  23.135 -\             .& .~ unchanged <e p, c p, r p, m p, rmhist@p>  .& $(S1 rmhist p) \
  23.136 -\   .-> (S2 rmhist p)$ .& (ENext p) .& unchanged <c p, r p, m p>"
  23.137 -   (fn _ => [auto_tac (MI_css addsimps2 [ImpNext_def]
  23.138 -		              addSEs2 [S1ClerkUnchE,S1RPCUnchE,S1MemUnchE,S1HistE]),
  23.139 -	     ALLGOALS (action_simp_tac (simpset() addsimps [square_def]) [] [S1EnvE])
  23.140 +   "|- [HNext rmhist p]_(c p,r p,m p, rmhist!p) & ImpNext p  \
  23.141 +\             & ~unchanged (e p, c p, r p, m p, rmhist!p)  & $S1 rmhist p \
  23.142 +\      --> (S2 rmhist p)$ & ENext p & unchanged (c p, r p, m p)"
  23.143 +   (fn _ => [action_simp_tac (simpset() addsimps [ImpNext_def]) []
  23.144 +                             (map temp_elim [S1ClerkUnch,S1RPCUnch,S1MemUnch,S1Hist]) 1,
  23.145 +             auto_tac (MI_fast_css addSIs2 [S1Env])
  23.146  	    ]);
  23.147  
  23.148  qed_goal "Step1_2_2" MemoryImplementation.thy
  23.149 -   "[HNext rmhist p]_<c p,r p,m p, rmhist@p> .& ImpNext p  \
  23.150 -\             .& .~ unchanged <e p, c p, r p, m p, rmhist@p>  .& $(S2 rmhist p) \
  23.151 -\   .-> (S3 rmhist p)$ .& (MClkFwd memCh crCh cst p) .& unchanged <e p, r p, m p, rmhist@p>"
  23.152 -   (fn _ => [auto_tac (MI_css addsimps2 [ImpNext_def]
  23.153 -		              addSEs2 [S2EnvUnchE,S2RPCUnchE,S2MemUnchE,S2HistE]),
  23.154 -	     ALLGOALS (action_simp_tac (simpset() addsimps [square_def]) [] [S2ClerkE,S2ForwardE])
  23.155 +   "|- [HNext rmhist p]_(c p,r p,m p, rmhist!p) & ImpNext p  \
  23.156 +\             & ~unchanged (e p, c p, r p, m p, rmhist!p) & $S2 rmhist p \
  23.157 +\      --> (S3 rmhist p)$ & MClkFwd memCh crCh cst p & unchanged (e p, r p, m p, rmhist!p)"
  23.158 +   (fn _ => [action_simp_tac (simpset() addsimps [ImpNext_def]) []
  23.159 +                             (map temp_elim [S2EnvUnch,S2RPCUnch,S2MemUnch,S2Hist]) 1,
  23.160 +	     auto_tac (MI_fast_css addSIs2 [S2Clerk,S2Forward])
  23.161  	    ]);
  23.162  
  23.163  qed_goal "Step1_2_3" MemoryImplementation.thy
  23.164 -   "[HNext rmhist p]_<c p,r p,m p, rmhist@p> .& ImpNext p  \
  23.165 -\             .& .~ unchanged <e p, c p, r p, m p, rmhist@p>  .& $(S3 rmhist p) \
  23.166 -\   .-> ((S4 rmhist p)$ .& RPCFwd crCh rmCh rst p .& unchanged <e p, c p, m p, rmhist@p>) \
  23.167 -\        .| ((S6 rmhist p)$ .& RPCFail crCh rmCh rst p .& unchanged <e p, c p, m p>)"
  23.168 -   (fn _ => [action_simp_tac (simpset() addsimps [ImpNext_def])
  23.169 -	                     [] [S3EnvUnchE,S3ClerkUnchE,S3MemUnchE] 1,
  23.170 -             ALLGOALS (action_simp_tac (simpset() addsimps [square_def])
  23.171 -		                       [] [S3RPCE,S3ForwardE,S3FailE]),
  23.172 -             auto_tac (MI_css addEs2 [S3HistE])
  23.173 +   "|- [HNext rmhist p]_(c p,r p,m p, rmhist!p) & ImpNext p  \
  23.174 +\             & ~unchanged (e p, c p, r p, m p, rmhist!p) & $S3 rmhist p \
  23.175 +\      --> ((S4 rmhist p)$ & RPCFwd crCh rmCh rst p & unchanged (e p, c p, m p, rmhist!p)) \
  23.176 +\        | ((S6 rmhist p)$ & RPCFail crCh rmCh rst p & unchanged (e p, c p, m p))"
  23.177 +   (fn _ => [action_simp_tac (simpset() addsimps [ImpNext_def]) []
  23.178 +	          (map temp_elim [S3EnvUnch,S3ClerkUnch,S3MemUnch]) 1,
  23.179 +             action_simp_tac (simpset()) [] 
  23.180 +                  (squareE::map temp_elim [S3RPC,S3Forward,S3Fail]) 1,
  23.181 +             auto_tac (MI_css addDs2 [S3Hist])
  23.182  	    ]);
  23.183  
  23.184  qed_goal "Step1_2_4" MemoryImplementation.thy
  23.185 -   "[HNext rmhist p]_<c p,r p,m p, rmhist@p> .& ImpNext p  \
  23.186 -\             .& .~ unchanged <e p, c p, r p, m p, rmhist@p> \
  23.187 -\             .& $(S4 rmhist p) .& (RALL l. $(MemInv mem l))     \
  23.188 -\   .-> ((S4 rmhist p)$ .& Read rmCh mem ires p .& unchanged <e p, c p, r p, rmhist@p>) \
  23.189 -\        .| ((S4 rmhist p)$ .& (REX l. Write rmCh mem ires p l) .& unchanged <e p, c p, r p, rmhist@p>) \
  23.190 -\        .| ((S5 rmhist p)$ .& MemReturn rmCh ires p .& unchanged <e p, c p, r p>)"
  23.191 -   (fn _ => [action_simp_tac (simpset() addsimps [ImpNext_def]) 
  23.192 -                             [] [S4EnvUnchE,S4ClerkUnchE,S4RPCUnchE] 1,
  23.193 -             ALLGOALS (action_simp_tac (simpset() addsimps [square_def,RNext_def])
  23.194 -                                       [] [S4ReadE,S4WriteE,S4ReturnE]),
  23.195 -             auto_tac (MI_css addEs2 [S4HistE])
  23.196 +   "|- [HNext rmhist p]_(c p,r p,m p, rmhist!p) & ImpNext p  \
  23.197 +\             & ~unchanged (e p, c p, r p, m p, rmhist!p) \
  23.198 +\             & $S4 rmhist p & (!l. $(MemInv mm l))     \
  23.199 +\      --> ((S4 rmhist p)$ & Read rmCh mm ires p & unchanged (e p, c p, r p, rmhist!p)) \
  23.200 +\        | ((S4 rmhist p)$ & (? l. Write rmCh mm ires p l) & unchanged (e p, c p, r p, rmhist!p)) \
  23.201 +\        | ((S5 rmhist p)$ & MemReturn rmCh ires p & unchanged (e p, c p, r p))"
  23.202 +   (fn _ => [action_simp_tac (simpset() addsimps [ImpNext_def]) []
  23.203 +                             (map temp_elim [S4EnvUnch,S4ClerkUnch,S4RPCUnch]) 1,
  23.204 +             action_simp_tac (simpset() addsimps [RNext_def]) []
  23.205 +                             (squareE::map temp_elim [S4Read,S4Write,S4Return]) 1,
  23.206 +             auto_tac (MI_css addDs2 [S4Hist])
  23.207              ]);
  23.208  
  23.209  qed_goal "Step1_2_5" MemoryImplementation.thy
  23.210 -   "[HNext rmhist p]_<c p,r p,m p, rmhist@p> .& ImpNext p  \
  23.211 -\             .& .~ unchanged <e p, c p, r p, m p, rmhist@p>  .& $(S5 rmhist p) \
  23.212 -\   .-> ((S6 rmhist p)$ .& RPCReply crCh rmCh rst p .& unchanged <e p, c p, m p>) \
  23.213 -\        .| ((S6 rmhist p)$ .& RPCFail crCh rmCh rst p .& unchanged <e p, c p, m p>)"
  23.214 -   (fn _ => [action_simp_tac (simpset() addsimps [ImpNext_def]) 
  23.215 -                             [] [S5EnvUnchE,S5ClerkUnchE,S5MemUnchE,S5HistE] 1,
  23.216 -	     action_simp_tac (simpset() addsimps [square_def]) [] [S5RPCE] 1,
  23.217 -	     auto_tac (MI_fast_css addSEs2 [S5ReplyE,S5FailE])
  23.218 +   "|- [HNext rmhist p]_(c p,r p,m p, rmhist!p) & ImpNext p  \
  23.219 +\             & ~unchanged (e p, c p, r p, m p, rmhist!p) & $S5 rmhist p \
  23.220 +\      --> ((S6 rmhist p)$ & RPCReply crCh rmCh rst p & unchanged (e p, c p, m p)) \
  23.221 +\        | ((S6 rmhist p)$ & RPCFail crCh rmCh rst p & unchanged (e p, c p, m p))"
  23.222 +   (fn _ => [action_simp_tac (simpset() addsimps [ImpNext_def]) []
  23.223 +                             (map temp_elim [S5EnvUnch,S5ClerkUnch,S5MemUnch,S5Hist]) 1,
  23.224 +	     action_simp_tac (simpset()) [] [squareE, temp_elim S5RPC] 1,
  23.225 +	     auto_tac (MI_fast_css addSDs2 [S5Reply,S5Fail])
  23.226  	    ]);
  23.227  
  23.228  qed_goal "Step1_2_6" MemoryImplementation.thy
  23.229 -   "[HNext rmhist p]_<c p,r p,m p, rmhist@p> .& ImpNext p  \
  23.230 -\             .& .~ unchanged <e p, c p, r p, m p, rmhist@p>  .& $(S6 rmhist p) \
  23.231 -\   .-> ((S1 rmhist p)$ .& (MClkReply memCh crCh cst p) .& unchanged <e p, r p, m p>)\
  23.232 -\        .| ((S3 rmhist p)$ .& (MClkRetry memCh crCh cst p) .& unchanged <e p,r p,m p,rmhist@p>)"
  23.233 -   (fn _ => [action_simp_tac (simpset() addsimps [ImpNext_def]) 
  23.234 -                             [] [S6EnvUnchE,S6RPCUnchE,S6MemUnchE] 1,
  23.235 -             ALLGOALS (action_simp_tac (simpset() addsimps [square_def]) 
  23.236 -                                       [] [S6ClerkE,S6RetryE,S6ReplyE]),
  23.237 -             auto_tac (MI_css addEs2 [S6HistE])
  23.238 +   "|- [HNext rmhist p]_(c p,r p,m p, rmhist!p) & ImpNext p  \
  23.239 +\             & ~unchanged (e p, c p, r p, m p, rmhist!p) & $S6 rmhist p \
  23.240 +\      --> ((S1 rmhist p)$ & MClkReply memCh crCh cst p & unchanged (e p, r p, m p))\
  23.241 +\        | ((S3 rmhist p)$ & MClkRetry memCh crCh cst p & unchanged (e p,r p,m p,rmhist!p))"
  23.242 +   (fn _ => [action_simp_tac (simpset() addsimps [ImpNext_def]) []
  23.243 +                             (map temp_elim [S6EnvUnch,S6RPCUnch,S6MemUnch]) 1,
  23.244 +             action_simp_tac (simpset()) []
  23.245 +                             (squareE::map temp_elim [S6Clerk,S6Retry,S6Reply]) 1,
  23.246 +             auto_tac (MI_css addDs2 [S6Hist])
  23.247              ]);
  23.248  
  23.249 -
  23.250  (* --------------------------------------------------------------------------
  23.251     Step 1.3: S1 implies the barred initial condition.
  23.252  *)
  23.253  
  23.254  section "Initialization (Step 1.3)";
  23.255  
  23.256 -val resbar_unl = rewrite_rule [slice_def] (action_unlift resbar_def);
  23.257 -
  23.258  qed_goal "Step1_3" MemoryImplementation.thy 
  23.259 -   "$(S1 rmhist p) .-> $(PInit (resbar rmhist) p)"
  23.260 -   (fn _ => [action_simp_tac (simpset() addsimps [resbar_unl,PInit_def,S_def,S1_def])
  23.261 +   "|- S1 rmhist p --> PInit (resbar rmhist) p"
  23.262 +   (fn _ => [action_simp_tac (simpset() addsimps [resbar_def,PInit_def,S_def,S1_def])
  23.263                               [] [] 1
  23.264              ]);
  23.265  
  23.266 @@ -211,52 +169,51 @@
  23.267  section "Step simulation (Step 1.4)";
  23.268  
  23.269  qed_goal "Step1_4_1" MemoryImplementation.thy
  23.270 -   "ENext p .& $(S1 rmhist p) .& (S2 rmhist p)$ .& unchanged <c p, r p, m p> \
  23.271 -\   .-> unchanged <rtrner memCh @ p, resbar rmhist @ p>"
  23.272 -  (fn _ => [ auto_tac (MI_fast_css addsimps2 [c_def,r_def,m_def,resbar_unl]) ]);
  23.273 +   "|- ENext p & $S1 rmhist p & (S2 rmhist p)$ & unchanged (c p, r p, m p) \
  23.274 +\      --> unchanged (rtrner memCh!p, resbar rmhist!p)"
  23.275 +  (fn _ => [ auto_tac (MI_fast_css addsimps2 [c_def,r_def,m_def,resbar_def]) ]);
  23.276  
  23.277  qed_goal "Step1_4_2" MemoryImplementation.thy
  23.278 -   "MClkFwd memCh crCh cst p .& $(S2 rmhist p) .& (S3 rmhist p)$  \
  23.279 -\                            .& unchanged <e p, r p, m p, rmhist@p> \
  23.280 -\   .-> unchanged <rtrner memCh @ p, resbar rmhist @ p>"
  23.281 -  (fn _ => [auto_tac (MI_fast_css 
  23.282 -                      addsimps2 [MClkFwd_def, e_def, r_def, m_def, resbar_unl,
  23.283 -                                 S_def, S2_def, S3_def])
  23.284 +   "|- MClkFwd memCh crCh cst p & $S2 rmhist p & (S3 rmhist p)$  \
  23.285 +\                & unchanged (e p, r p, m p, rmhist!p) \
  23.286 +\      --> unchanged (rtrner memCh!p, resbar rmhist!p)"
  23.287 +  (fn _ => [action_simp_tac
  23.288 +                (simpset() addsimps [MClkFwd_def, e_def, r_def, m_def, resbar_def,
  23.289 +                                     S_def, S2_def, S3_def]) [] [] 1
  23.290             ]);
  23.291  
  23.292  qed_goal "Step1_4_3a" MemoryImplementation.thy
  23.293 -   "RPCFwd crCh rmCh rst p .& $(S3 rmhist p) .& (S4 rmhist p)$    \
  23.294 -\                          .& unchanged <e p, c p, m p, rmhist@p> \
  23.295 -\   .-> unchanged <rtrner memCh @ p, resbar rmhist @ p>"
  23.296 -  (fn _ => [auto_tac (MI_fast_css addsimps2 [e_def,c_def,m_def,resbar_unl]),
  23.297 -	      (* NB: Adding S3_exclE,S4_exclE as safe elims above would loop,
  23.298 -                     adding them as unsafe elims doesn't help, 
  23.299 -                     because auto_tac doesn't find the proof! *)
  23.300 -            REPEAT (eresolve_tac [S3_exclE,S4_exclE] 1),
  23.301 -            action_simp_tac (simpset() addsimps [S_def, S3_def]) [] [] 1
  23.302 +   "|- RPCFwd crCh rmCh rst p & $S3 rmhist p & (S4 rmhist p)$    \
  23.303 +\                  & unchanged (e p, c p, m p, rmhist!p) \
  23.304 +\      --> unchanged (rtrner memCh!p, resbar rmhist!p)"
  23.305 +  (fn _ => [Clarsimp_tac 1,
  23.306 +            REPEAT (dresolve_tac (map temp_use [S3_excl,S4_excl]) 1),
  23.307 +            action_simp_tac 
  23.308 +                 (simpset() addsimps [e_def,c_def,m_def,resbar_def,S_def, S3_def]) [] [] 1
  23.309             ]);
  23.310  
  23.311  qed_goal "Step1_4_3b" MemoryImplementation.thy
  23.312 -   "RPCFail crCh rmCh rst p .& $(S3 rmhist p) .& (S6 rmhist p)$ .& unchanged <e p, c p, m p>\
  23.313 -\   .-> MemFail memCh (resbar rmhist) p"
  23.314 -  (fn _ => [auto_tac (MI_css addsimps2 [RPCFail_def,MemFail_def,e_def,c_def,m_def,
  23.315 -		                        resbar_unl]),
  23.316 -	        (* It's faster not to expand S3 at once *)
  23.317 -            action_simp_tac (simpset() addsimps [S3_def,S_def]) [] [] 1,
  23.318 -            etac S6_exclE 1,
  23.319 -            auto_tac (MI_fast_css addsimps2 [Return_def])
  23.320 +   "|- RPCFail crCh rmCh rst p & $S3 rmhist p & (S6 rmhist p)$ & unchanged (e p, c p, m p) \
  23.321 +\      --> MemFail memCh (resbar rmhist) p"
  23.322 +  (fn _ => [Clarsimp_tac 1,
  23.323 +            dtac (temp_use S6_excl) 1,
  23.324 +            auto_tac (MI_css addsimps2 [RPCFail_def,MemFail_def,e_def,c_def,m_def,
  23.325 +		                        resbar_def]),
  23.326 +            force_tac (MI_css addsimps2 [S3_def,S_def]) 1,
  23.327 +            auto_tac (MI_css addsimps2 [Return_def])
  23.328             ]);
  23.329  
  23.330  
  23.331  qed_goal "Step1_4_4a1" MemoryImplementation.thy
  23.332 -   "$(S4 rmhist p) .& (S4 rmhist p)$ .& ReadInner rmCh mem ires p l \
  23.333 -\   .& unchanged <e p, c p, r p, rmhist@p> .& $(MemInv mem l) \
  23.334 -\   .-> ReadInner memCh mem (resbar rmhist) p l"
  23.335 -  (fn _ => [action_simp_tac 
  23.336 +   "|- $S4 rmhist p & (S4 rmhist p)$ & ReadInner rmCh mm ires p l \
  23.337 +\             & unchanged (e p, c p, r p, rmhist!p) & $MemInv mm l \
  23.338 +\      --> ReadInner memCh mm (resbar rmhist) p l"
  23.339 +  (fn _ => [Clarsimp_tac 1,
  23.340 +            REPEAT (dtac (temp_use S4_excl) 1),
  23.341 +            action_simp_tac 
  23.342                 (simpset() addsimps [ReadInner_def,GoodRead_def,BadRead_def,e_def,c_def,m_def]) 
  23.343                 [] [] 1,
  23.344 -            ALLGOALS (REPEAT o (etac S4_exclE)),
  23.345 -            auto_tac (MI_css addsimps2 [resbar_unl]),
  23.346 +            auto_tac (MI_css addsimps2 [resbar_def]),
  23.347  	    ALLGOALS (action_simp_tac 
  23.348                          (simpset() addsimps [RPCRelayArg_def,MClkRelayArg_def,
  23.349  		                            S_def,S4_def,RdRequest_def,MemInv_def])
  23.350 @@ -264,22 +221,22 @@
  23.351             ]);
  23.352  
  23.353  qed_goal "Step1_4_4a" MemoryImplementation.thy
  23.354 -   "Read rmCh mem ires p .& $(S4 rmhist p) .& (S4 rmhist p)$ \
  23.355 -\   .& unchanged <e p, c p, r p, rmhist@p> .& (RALL l. $(MemInv mem l)) \
  23.356 -\   .-> Read memCh mem (resbar rmhist) p"
  23.357 -  (fn _ => [ auto_tac (MI_css addsimps2 [Read_def] addSIs2 [action_mp Step1_4_4a1]) ]);
  23.358 +   "|- Read rmCh mm ires p & $S4 rmhist p & (S4 rmhist p)$ \
  23.359 +\           & unchanged (e p, c p, r p, rmhist!p) & (!l. $(MemInv mm l)) \
  23.360 +\      --> Read memCh mm (resbar rmhist) p"
  23.361 +  (fn _ => [ force_tac (MI_css addsimps2 [Read_def] addSEs2 [Step1_4_4a1]) 1 ]);
  23.362  
  23.363  qed_goal "Step1_4_4b1" MemoryImplementation.thy
  23.364 -   "$(S4 rmhist p) .& (S4 rmhist p)$ .& WriteInner rmCh mem ires p l v   \
  23.365 -\                                    .& unchanged <e p, c p, r p, rmhist@p> \
  23.366 -\   .-> WriteInner memCh mem (resbar rmhist) p l v"
  23.367 -  (fn _ => [action_simp_tac 
  23.368 +   "|- $S4 rmhist p & (S4 rmhist p)$ & WriteInner rmCh mm ires p l v   \
  23.369 +\                   & unchanged (e p, c p, r p, rmhist!p) \
  23.370 +\      --> WriteInner memCh mm (resbar rmhist) p l v"
  23.371 +  (fn _ => [Clarsimp_tac 1,
  23.372 +            REPEAT (dtac (temp_use S4_excl) 1),
  23.373 +            action_simp_tac 
  23.374                 (simpset() addsimps [WriteInner_def, GoodWrite_def, BadWrite_def,
  23.375  			           e_def, c_def, m_def])
  23.376                 [] [] 1,
  23.377 -            ALLGOALS (REPEAT o (etac S4_exclE)),
  23.378 -	    auto_tac (MI_css addsimps2 [resbar_unl]),
  23.379 -               (* it's faster not to merge the two simplifications *)
  23.380 +	    auto_tac (MI_css addsimps2 [resbar_def]),
  23.381  	    ALLGOALS (action_simp_tac
  23.382                          (simpset() addsimps [RPCRelayArg_def,MClkRelayArg_def,
  23.383  		                            S_def,S4_def,WrRequest_def])
  23.384 @@ -287,99 +244,93 @@
  23.385             ]);
  23.386  
  23.387  qed_goal "Step1_4_4b" MemoryImplementation.thy
  23.388 -   "Write rmCh mem ires p l .& $(S4 rmhist p) .& (S4 rmhist p)$   \
  23.389 -\                           .& unchanged <e p, c p, r p, rmhist@p> \
  23.390 -\   .-> Write memCh mem (resbar rmhist) p l"
  23.391 -  (fn _ => [ auto_tac (MI_css addsimps2 [Write_def] addSIs2 [action_mp Step1_4_4b1]) ]);
  23.392 +   "|- Write rmCh mm ires p l & $S4 rmhist p & (S4 rmhist p)$   \
  23.393 +\                 & unchanged (e p, c p, r p, rmhist!p) \
  23.394 +\      --> Write memCh mm (resbar rmhist) p l"
  23.395 +  (fn _ => [ force_tac (MI_css addsimps2 [Write_def] addSEs2 [Step1_4_4b1]) 1 ]);
  23.396  
  23.397  qed_goal "Step1_4_4c" MemoryImplementation.thy
  23.398 -   "MemReturn rmCh ires p .& $(S4 rmhist p) .& (S5 rmhist p)$ .& unchanged <e p, c p, r p> \
  23.399 -\   .-> unchanged <rtrner memCh @ p, resbar rmhist @ p>"
  23.400 +   "|- MemReturn rmCh ires p & $S4 rmhist p & (S5 rmhist p)$ & unchanged (e p, c p, r p) \
  23.401 +\      --> unchanged (rtrner memCh!p, resbar rmhist!p)"
  23.402    (fn _ => [action_simp_tac
  23.403 -	       (simpset() addsimps [e_def,c_def,r_def,resbar_unl]) [] [] 1,
  23.404 -	    REPEAT (eresolve_tac [S4_exclE,S5_exclE] 1),
  23.405 +	       (simpset() addsimps [e_def,c_def,r_def,resbar_def]) [] [] 1,
  23.406 +	    REPEAT (dresolve_tac [temp_use S4_excl, temp_use S5_excl] 1),
  23.407  	    auto_tac (MI_fast_css addsimps2 [MemReturn_def,Return_def])
  23.408             ]);
  23.409  
  23.410  qed_goal "Step1_4_5a" MemoryImplementation.thy
  23.411 -   "RPCReply crCh rmCh rst p .& $(S5 rmhist p) .& (S6 rmhist p)$ .& unchanged <e p, c p, m p> \
  23.412 -\   .-> unchanged <rtrner memCh @ p, resbar rmhist @ p>"
  23.413 -  (fn _ => [auto_tac (MI_css addsimps2 [e_def,c_def,m_def, resbar_unl]),
  23.414 -            REPEAT (eresolve_tac [S5_exclE,S6_exclE] 1),
  23.415 -	    auto_tac (MI_css addsimps2 [RPCReply_def,Return_def,S5_def,S_def]
  23.416 -		             addSEs2 [MVOKBAnotRFE])
  23.417 +   "|- RPCReply crCh rmCh rst p & $S5 rmhist p & (S6 rmhist p)$ & unchanged (e p, c p, m p) \
  23.418 +\      --> unchanged (rtrner memCh!p, resbar rmhist!p)"
  23.419 +  (fn _ => [Clarsimp_tac 1,
  23.420 +            REPEAT (dresolve_tac [temp_use S5_excl, temp_use S6_excl] 1),
  23.421 +            auto_tac (MI_css addsimps2 [e_def,c_def,m_def, resbar_def]),
  23.422 +	    auto_tac (MI_css addsimps2 [RPCReply_def,Return_def,S5_def,S_def] 
  23.423 +                             addSDs2 [MVOKBAnotRF])
  23.424             ]);
  23.425  
  23.426  qed_goal "Step1_4_5b" MemoryImplementation.thy
  23.427 -   "RPCFail crCh rmCh rst p .& $(S5 rmhist p) .& (S6 rmhist p)$ .& unchanged <e p, c p, m p>\
  23.428 -\   .-> MemFail memCh (resbar rmhist) p"
  23.429 -  (fn _ => [action_simp_tac
  23.430 -	       (simpset() addsimps [e_def, c_def, m_def, RPCFail_def, Return_def,
  23.431 -				   MemFail_def, resbar_unl])
  23.432 -	       [] [] 1,
  23.433 -	    action_simp_tac (simpset() addsimps [S5_def,S_def]) [] [] 1,
  23.434 -            etac S6_exclE 1,
  23.435 -	    auto_tac MI_css
  23.436 +   "|- RPCFail crCh rmCh rst p & $S5 rmhist p & (S6 rmhist p)$ & unchanged (e p, c p, m p) \
  23.437 +\      --> MemFail memCh (resbar rmhist) p"
  23.438 +  (fn _ => [Clarsimp_tac 1,
  23.439 +            dtac (temp_use S6_excl) 1,
  23.440 +            auto_tac (MI_css addsimps2 [e_def, c_def, m_def, RPCFail_def, Return_def,
  23.441 +		 		        MemFail_def, resbar_def]),
  23.442 +	    auto_tac (MI_css addsimps2 [S5_def,S_def])
  23.443             ]);
  23.444  
  23.445  qed_goal "Step1_4_6a" MemoryImplementation.thy
  23.446 -   "MClkReply memCh crCh cst p .& $(S6 rmhist p) .& (S1 rmhist p)$ .& unchanged <e p, r p, m p> \
  23.447 -\   .-> MemReturn memCh (resbar rmhist) p"
  23.448 -  (fn _ => [action_simp_tac
  23.449 +   "|- MClkReply memCh crCh cst p & $S6 rmhist p & (S1 rmhist p)$ & unchanged (e p, r p, m p) \
  23.450 +\      --> MemReturn memCh (resbar rmhist) p"
  23.451 +  (fn _ => [Clarsimp_tac 1,
  23.452 +            dtac (temp_use S6_excl) 1,
  23.453 +            action_simp_tac
  23.454  	      (simpset() addsimps [e_def, r_def, m_def, MClkReply_def, MemReturn_def,
  23.455 -				  Return_def, resbar_unl]) 
  23.456 -              [] [] 1,
  23.457 -            ALLGOALS (etac S6_exclE),
  23.458 +				  Return_def, resbar_def]) [] [] 1,
  23.459  	    ALLGOALS Asm_full_simp_tac,  (* simplify if-then-else *)
  23.460  	    ALLGOALS (action_simp_tac
  23.461      	              (simpset() addsimps [MClkReplyVal_def,S6_def,S_def])
  23.462 -		      [] []),
  23.463 -            rtac ifI 1,
  23.464 -            ALLGOALS (action_simp_tac (simpset()) [] [MVOKBARFnotNRE])
  23.465 +		      [] [MVOKBARFnotNR])
  23.466             ]);
  23.467  
  23.468  qed_goal "Step1_4_6b" MemoryImplementation.thy
  23.469 -   "MClkRetry memCh crCh cst p .& $(S6 rmhist p) .& (S3 rmhist p)$   \
  23.470 -\                              .& unchanged <e p, r p, m p, rmhist@p> \
  23.471 -\   .-> MemFail memCh (resbar rmhist) p"
  23.472 -  (fn _ => [action_simp_tac
  23.473 -	       (simpset() addsimps [e_def, r_def, m_def, MClkRetry_def, MemFail_def, resbar_unl])
  23.474 +   "|- MClkRetry memCh crCh cst p & $S6 rmhist p & (S3 rmhist p)$   \
  23.475 +\                & unchanged (e p, r p, m p, rmhist!p) \
  23.476 +\      --> MemFail memCh (resbar rmhist) p"
  23.477 +  (fn _ => [Clarsimp_tac 1,
  23.478 +            dtac (temp_use S3_excl) 1,
  23.479 +            action_simp_tac
  23.480 +	       (simpset() addsimps [e_def, r_def, m_def, MClkRetry_def, MemFail_def, resbar_def])
  23.481  	       [] [] 1,
  23.482 -	    SELECT_GOAL (auto_tac (MI_css addsimps2 [S6_def,S_def])) 1,
  23.483 -            etac S3_exclE 1,
  23.484 -            Asm_full_simp_tac 1,
  23.485 -	    action_simp_tac (simpset() addsimps [S6_def,S3_def,S_def]) [] [] 1
  23.486 +	    auto_tac (MI_css addsimps2 [S6_def,S_def])
  23.487             ]);
  23.488  
  23.489  qed_goal "S_lemma" MemoryImplementation.thy
  23.490 -   "unchanged <e p, c p, r p, m p, rmhist@p> \
  23.491 -\   .-> unchanged (S rmhist ec cc rc cs rs hs1 hs2 p)"
  23.492 +   "|- unchanged (e p, c p, r p, m p, rmhist!p) \
  23.493 +\      --> unchanged (S rmhist ec cc rc cs rs hs1 hs2 p)"
  23.494     (fn _ => [auto_tac (MI_css addsimps2 [e_def,c_def,r_def,m_def,caller_def,rtrner_def,
  23.495  					 S_def,Calling_def])
  23.496              ]);
  23.497  
  23.498  qed_goal "Step1_4_7H" MemoryImplementation.thy
  23.499 -   "unchanged <e p, c p, r p, m p, rmhist@p> \
  23.500 -\   .-> unchanged <rtrner memCh @ p, S1 rmhist p, S2 rmhist p, S3 rmhist p, \
  23.501 -\                                    S4 rmhist p, S5 rmhist p, S6 rmhist p>"
  23.502 -   (fn _ => [Action_simp_tac 1,
  23.503 -	     SELECT_GOAL (auto_tac (MI_fast_css addsimps2 [c_def])) 1,
  23.504 -             ALLGOALS (simp_tac (simpset()
  23.505 -				 addsimps [S1_def,S2_def,S3_def,S4_def,S5_def,S6_def])),
  23.506 -	     auto_tac (MI_css addSIs2 [action_mp S_lemma])
  23.507 +   "|- unchanged (e p, c p, r p, m p, rmhist!p) \
  23.508 +\      --> unchanged (rtrner memCh!p, S1 rmhist p, S2 rmhist p, S3 rmhist p, \
  23.509 +\                     S4 rmhist p, S5 rmhist p, S6 rmhist p)"
  23.510 +   (fn _ => [Clarsimp_tac 1,
  23.511 +             rtac conjI 1,
  23.512 +             force_tac (MI_css addsimps2 [c_def]) 1,
  23.513 +             force_tac (MI_css addsimps2 [S1_def,S2_def,S3_def,S4_def,S5_def,S6_def]
  23.514 +                               addSIs2 [S_lemma]) 1
  23.515              ]);
  23.516  
  23.517 -(* unlifted version as elimination rule *)
  23.518 -bind_thm("Step1_4_7h",
  23.519 -	 (rewrite_rule action_rews (Step1_4_7H RS actionD)) RS impdupE);
  23.520 -
  23.521  qed_goal "Step1_4_7" MemoryImplementation.thy
  23.522 -   "unchanged <e p, c p, r p, m p, rmhist@p> .-> unchanged <rtrner memCh @ p, resbar rmhist @ p>"
  23.523 +   "|- unchanged (e p, c p, r p, m p, rmhist!p) \
  23.524 +\      --> unchanged (rtrner memCh!p, resbar rmhist!p, S1 rmhist p, S2 rmhist p, S3 rmhist p, \
  23.525 +\                     S4 rmhist p, S5 rmhist p, S6 rmhist p)"
  23.526    (fn _ => [rtac actionI 1,
  23.527              rewrite_goals_tac action_rews,
  23.528              rtac impI 1,
  23.529 -            etac Step1_4_7h 1,
  23.530 -	    auto_tac (MI_css addsimps2 [e_def,c_def,r_def,m_def,rtrner_def,resbar_unl])
  23.531 +            forward_tac [temp_use Step1_4_7H] 1,
  23.532 +	    auto_tac (MI_css addsimps2 [e_def,c_def,r_def,m_def,rtrner_def,resbar_def])
  23.533             ]);
  23.534  
  23.535  
  23.536 @@ -387,10 +338,10 @@
  23.537     steps of the implementation, and try to solve the idling case by simplification
  23.538  *)
  23.539  fun split_idle_tac simps i = 
  23.540 -    EVERY [rtac actionI i,
  23.541 -	   case_tac "(unchanged <e p, c p, r p, m p, rmhist@p>) [[s,t]]" i,
  23.542 +    EVERY [TRY (rtac actionI i),
  23.543 +	   case_tac "(s,t) |= unchanged (e p, c p, r p, m p, rmhist!p)" i,
  23.544  	   rewrite_goals_tac action_rews,
  23.545 -	   etac Step1_4_7h i,
  23.546 +	   forward_tac [temp_use Step1_4_7] i,
  23.547  	   asm_full_simp_tac (simpset() addsimps simps) i
  23.548  	  ];
  23.549  
  23.550 @@ -402,75 +353,72 @@
  23.551  (* Steps that leave all variables unchanged are safe, so I may assume
  23.552     that some variable changes in the proof that a step is safe. *)
  23.553  qed_goal "unchanged_safe" MemoryImplementation.thy
  23.554 -   "(.~ (unchanged <e p, c p, r p, m p, rmhist@p>) \
  23.555 -\      .-> [UNext memCh mem (resbar rmhist) p]_<rtrner memCh @ p, resbar rmhist @ p>) \
  23.556 -\   .-> [UNext memCh mem (resbar rmhist) p]_<rtrner memCh @ p, resbar rmhist @ p>"
  23.557 -   (fn _ => [rtac actionI 1,
  23.558 -             case_tac "(unchanged <e p, c p, r p, m p, rmhist@p>) [[s,t]]" 1,
  23.559 -	     rewrite_goals_tac action_rews,
  23.560 -	     auto_tac (MI_css addsimps2 [square_def] addSEs2 [action_impE Step1_4_7])
  23.561 +   "|- (~unchanged (e p, c p, r p, m p, rmhist!p) \
  23.562 +\        --> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)) \
  23.563 +\      --> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)"
  23.564 +   (fn _ => [split_idle_tac [square_def] 1,
  23.565 +             Force_tac 1
  23.566              ]);
  23.567  (* turn into (unsafe, looping!) introduction rule *)
  23.568 -bind_thm("unchanged_safeI", impI RS (action_mp unchanged_safe));
  23.569 +bind_thm("unchanged_safeI", impI RS (action_use unchanged_safe));
  23.570  
  23.571  qed_goal "S1safe" MemoryImplementation.thy
  23.572 -   "$(S1 rmhist p) .& ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>   \
  23.573 -\  .-> [UNext memCh mem (resbar rmhist) p]_<rtrner memCh @ p, resbar rmhist @ p>"
  23.574 -   (fn _ => [Action_simp_tac 1, 
  23.575 +   "|- $S1 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)   \
  23.576 +\      --> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)"
  23.577 +   (fn _ => [Clarsimp_tac 1, 
  23.578               rtac unchanged_safeI 1,
  23.579               rtac idle_squareI 1,
  23.580 -	     auto_tac (MI_css addSEs2 (map action_conjimpE [Step1_2_1,Step1_4_1]))
  23.581 +	     auto_tac (MI_css addSDs2 [Step1_2_1,Step1_4_1])
  23.582  	    ]);
  23.583  
  23.584  qed_goal "S2safe" MemoryImplementation.thy
  23.585 -   "$(S2 rmhist p) .& ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>   \
  23.586 -\  .-> [UNext memCh mem (resbar rmhist) p]_<rtrner memCh @ p, resbar rmhist @ p>"
  23.587 -   (fn _ => [Action_simp_tac 1, 
  23.588 +   "|- $S2 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)   \
  23.589 +\      --> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)"
  23.590 +   (fn _ => [Clarsimp_tac 1, 
  23.591               rtac unchanged_safeI 1,
  23.592               rtac idle_squareI 1,
  23.593 -	     auto_tac (MI_fast_css addSEs2 (map action_conjimpE [Step1_2_2,Step1_4_2]))
  23.594 +	     auto_tac (MI_css addSDs2 [Step1_2_2,Step1_4_2])
  23.595  	    ]);
  23.596  
  23.597  qed_goal "S3safe" MemoryImplementation.thy
  23.598 -   "$(S3 rmhist p) .& ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>   \
  23.599 -\  .-> [UNext memCh mem (resbar rmhist) p]_<rtrner memCh @ p, resbar rmhist @ p>"
  23.600 -   (fn _ => [Action_simp_tac 1,
  23.601 +   "|- $S3 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)   \
  23.602 +\      --> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)"
  23.603 +   (fn _ => [Clarsimp_tac 1,
  23.604  	     rtac unchanged_safeI 1,
  23.605 -             auto_tac (MI_css addSEs2 [action_conjimpE Step1_2_3]),
  23.606 -	     auto_tac (MI_fast_css addsimps2 [square_def,UNext_def]
  23.607 -		              addSEs2 (map action_conjimpE [Step1_4_3a,Step1_4_3b]))
  23.608 +             auto_tac (MI_css addSDs2 [Step1_2_3]),
  23.609 +	     auto_tac (MI_css addsimps2 [square_def,UNext_def]
  23.610 +		              addSDs2 [Step1_4_3a,Step1_4_3b])
  23.611  	    ]);
  23.612  
  23.613  qed_goal "S4safe" MemoryImplementation.thy
  23.614 -   "$(S4 rmhist p) .& ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>  \
  23.615 -\                  .& (RALL l. $(MemInv mem l)) \
  23.616 -\  .-> [UNext memCh mem (resbar rmhist) p]_<rtrner memCh @ p, resbar rmhist @ p>"
  23.617 -   (fn _ => [Action_simp_tac 1,
  23.618 +   "|- $S4 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)  \
  23.619 +\                   & (!l. $(MemInv mm l)) \
  23.620 +\      --> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)"
  23.621 +   (fn _ => [Clarsimp_tac 1,
  23.622  	     rtac unchanged_safeI 1,
  23.623 -             auto_tac (MI_css addSEs2 [action_conjimpE Step1_2_4]),
  23.624 -             ALLGOALS (action_simp_tac (simpset() addsimps [square_def,UNext_def,RNext_def]) [] []),
  23.625 -	     auto_tac (MI_fast_css addSEs2 (map action_conjimpE 
  23.626 -                                                [Step1_4_4a,Step1_4_4b,Step1_4_4c]))
  23.627 +             auto_tac (MI_css addSDs2 [Step1_2_4]),
  23.628 +	     auto_tac (MI_css addsimps2 [square_def,UNext_def,RNext_def]
  23.629 +                              addSDs2 [Step1_4_4a,Step1_4_4b,Step1_4_4c])
  23.630  	    ]);
  23.631  
  23.632  qed_goal "S5safe" MemoryImplementation.thy
  23.633 -   "$(S5 rmhist p) .& ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>  \
  23.634 -\  .-> [UNext memCh mem (resbar rmhist) p]_<rtrner memCh @ p, resbar rmhist @ p>"
  23.635 -   (fn _ => [Action_simp_tac 1,
  23.636 +   "|- $S5 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)  \
  23.637 +\      --> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)"
  23.638 +   (fn _ => [Clarsimp_tac 1,
  23.639  	     rtac unchanged_safeI 1,
  23.640 -             auto_tac (MI_css addSEs2 [action_conjimpE Step1_2_5]),
  23.641 -	     auto_tac (MI_fast_css addsimps2 [square_def,UNext_def]
  23.642 -		              addSEs2 (map action_conjimpE [Step1_4_5a,Step1_4_5b]))
  23.643 +             auto_tac (MI_css addSDs2 [Step1_2_5]),
  23.644 +	     auto_tac (MI_css addsimps2 [square_def,UNext_def]
  23.645 +		              addSDs2 [Step1_4_5a,Step1_4_5b])
  23.646  	    ]);
  23.647  
  23.648  qed_goal "S6safe" MemoryImplementation.thy
  23.649 -   "$(S6 rmhist p) .& ImpNext p .& [HNext rmhist p]_<c p,r p,m p, rmhist@p>   \
  23.650 -\  .-> [UNext memCh mem (resbar rmhist) p]_<rtrner memCh @ p, resbar rmhist @ p>"
  23.651 -   (fn _ => [Action_simp_tac 1,
  23.652 +   "|- $S6 rmhist p & ImpNext p & [HNext rmhist p]_(c p,r p,m p, rmhist!p)   \
  23.653 +\      --> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)"
  23.654 +   (fn _ => [Clarsimp_tac 1,
  23.655  	     rtac unchanged_safeI 1,
  23.656 -             auto_tac (MI_css addSEs2 [action_conjimpE Step1_2_6]),
  23.657 -	     auto_tac (MI_fast_css addsimps2 [square_def,UNext_def,RNext_def]
  23.658 -		              addSEs2 (map action_conjimpE [Step1_4_6a,Step1_4_6b]))
  23.659 +             auto_tac (MI_css addSDs2 [Step1_2_6]),
  23.660 +	     auto_tac (MI_css addsimps2 [square_def,UNext_def,RNext_def]
  23.661 +		              addSDs2 [Step1_4_6a,Step1_4_6b])
  23.662  	    ]);
  23.663  
  23.664  (* ----------------------------------------------------------------------
  23.665 @@ -488,113 +436,99 @@
  23.666     b. "implementation invariant": always in states S1,...,S6
  23.667  *)
  23.668  qed_goal "Step1_5_1a" MemoryImplementation.thy 
  23.669 -   "IPImp p .-> (RALL l. []$(MemInv mem l))"
  23.670 -   (fn _ => [auto_tac (MI_css addsimps2 [IPImp_def]
  23.671 -			      addSIs2 [temp_mp MemoryInvariantAll])
  23.672 +   "|- IPImp p --> (!l. []$MemInv mm l)"
  23.673 +   (fn _ => [auto_tac (MI_css addsimps2 [IPImp_def,box_stp_act]
  23.674 +			      addSIs2 [MemoryInvariantAll])
  23.675  	    ]);
  23.676 -bind_thm("MemInvI", (rewrite_rule intensional_rews (Step1_5_1a RS tempD)) RS impdupE);
  23.677  
  23.678  qed_goal "Step1_5_1b" MemoryImplementation.thy
  23.679 -   "   Init($(ImpInit p) .& $(HInit rmhist p)) .& [](ImpNext p) \
  23.680 -\         .& [][HNext rmhist p]_<c p, r p, m p, rmhist@p> .& [](RALL l. $(MemInv mem l)) \
  23.681 -\   .-> []($(ImpInv rmhist p))"
  23.682 +   "|- Init(ImpInit p & HInit rmhist p) & [](ImpNext p) \
  23.683 +\      & [][HNext rmhist p]_(c p, r p, m p, rmhist!p) & [](!l. $MemInv mm l) \
  23.684 +\      --> []ImpInv rmhist p"
  23.685     (fn _ => [inv_tac MI_css 1,
  23.686 -	     auto_tac (MI_css
  23.687 -		       addsimps2 [Init_def, ImpInv_def]
  23.688 -		       addSEs2 [action_impE Step1_1]
  23.689 -		       addEs2 (map action_conjimpE
  23.690 -			           [S1_successors,S2_successors,S3_successors,
  23.691 -			            S4_successors,S5_successors,S6_successors]))
  23.692 +	     auto_tac (MI_css addsimps2 [Init_def, ImpInv_def, box_stp_act]
  23.693 +                              addSDs2 [Step1_1]
  23.694 +		              addDs2 [S1_successors,S2_successors,S3_successors,
  23.695 +			              S4_successors,S5_successors,S6_successors])
  23.696              ]);
  23.697 -bind_thm("ImpInvI", (rewrite_rule intensional_rews (Step1_5_1b RS tempD)) RS impdupE);
  23.698  
  23.699  (*** Initialization ***)
  23.700  qed_goal "Step1_5_2a" MemoryImplementation.thy
  23.701 -   "Init($(ImpInit p) .& $(HInit rmhist p)) .-> Init($PInit (resbar rmhist) p)"
  23.702 +   "|- Init(ImpInit p & HInit rmhist p) --> Init(PInit (resbar rmhist) p)"
  23.703     (fn _ => [auto_tac (MI_css addsimps2 [Init_def]
  23.704 -                              addSIs2 (map action_mp [Step1_1,Step1_3]))
  23.705 +                              addSIs2 [Step1_1,Step1_3])
  23.706              ]);
  23.707  
  23.708  (*** step simulation ***)
  23.709  qed_goal "Step1_5_2b" MemoryImplementation.thy
  23.710 -   "[](ImpNext p .& [HNext rmhist p]_<c p, r p, m p, rmhist@p>   \
  23.711 -\                .& $(ImpInv rmhist p) .& (RALL l. $(MemInv mem l)))   \
  23.712 -\   .-> [][UNext memCh mem (resbar rmhist) p]_<rtrner memCh @ p, resbar rmhist @ p>"
  23.713 -   (fn _ => [auto_tac (MI_fast_css 
  23.714 -                          addsimps2 [ImpInv_def] 
  23.715 -                          addSEs2 (STL4E::(map action_conjimpE
  23.716 -                                         [S1safe,S2safe,S3safe,S4safe,S5safe,S6safe])))
  23.717 +   "|- [](ImpNext p & [HNext rmhist p]_(c p, r p, m p, rmhist!p)   \
  23.718 +\                   & $ImpInv rmhist p & (!l. $MemInv mm l))       \
  23.719 +\      --> [][UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)"
  23.720 +   (fn _ => [auto_tac (MI_css 
  23.721 +                          addsimps2 [ImpInv_def] addSEs2 [STL4E]
  23.722 +                          addSDs2 [S1safe,S2safe,S3safe,S4safe,S5safe,S6safe])
  23.723              ]);
  23.724  
  23.725  
  23.726  (*** Liveness ***)
  23.727  qed_goal "GoodImpl" MemoryImplementation.thy
  23.728 -   "IPImp p .& HistP rmhist p  \
  23.729 -\   .->   Init($(ImpInit p) .& $(HInit rmhist p))   \
  23.730 -\      .& [](ImpNext p .& [HNext rmhist p]_<c p, r p, m p, rmhist@p>) \
  23.731 -\      .& [](RALL l. $(MemInv mem l)) .& []($(ImpInv rmhist p)) \
  23.732 -\      .& ImpLive p"
  23.733 -   (fn _ => [(* need some subgoals to prove [](ImpInv p), avoid duplication *)
  23.734 -	     rtac tempI 1, rewrite_goals_tac intensional_rews, rtac impI 1,
  23.735 -             subgoal_tac
  23.736 -	       "sigma |= Init($(ImpInit p) .& $(HInit rmhist p)) \
  23.737 -\                        .& [](ImpNext p) \
  23.738 -\                        .& [][HNext rmhist p]_<c p, r p, m p, rmhist@p> \
  23.739 -\                        .& [](RALL l. $(MemInv mem l))" 1,
  23.740 -	     auto_tac (MI_css addsimps2 [split_box_conj]
  23.741 -                              addSEs2 [temp_conjimpE Step1_5_1b]),
  23.742 -	     SELECT_GOAL
  23.743 -	        (auto_tac (MI_css addsimps2 [IPImp_def,MClkIPSpec_def,RPCIPSpec_def,RPSpec_def,
  23.744 -					     ImpLive_def,c_def,r_def,m_def])) 1,
  23.745 -	     SELECT_GOAL
  23.746 -	        (auto_tac (MI_css addsimps2 [IPImp_def,MClkIPSpec_def,RPCIPSpec_def,RPSpec_def,
  23.747 -					     HistP_def,Init_def,action_unlift ImpInit_def])) 1,
  23.748 -	     SELECT_GOAL
  23.749 -	        (auto_tac (MI_css addsimps2 [IPImp_def,MClkIPSpec_def,RPCIPSpec_def,RPSpec_def,
  23.750 -					     ImpNext_def,c_def,r_def,m_def,
  23.751 -					     split_box_conj])) 1,
  23.752 -	     SELECT_GOAL (auto_tac (MI_css addsimps2 [HistP_def])) 1,
  23.753 -             etac ((temp_mp Step1_5_1a) RS ((temp_unlift allT) RS iffD1)) 1
  23.754 +   "|- IPImp p & HistP rmhist p  \
  23.755 +\      -->   Init(ImpInit p & HInit rmhist p)   \
  23.756 +\          & [](ImpNext p & [HNext rmhist p]_(c p, r p, m p, rmhist!p)) \
  23.757 +\          & [](!l. $MemInv mm l) & []($ImpInv rmhist p) \
  23.758 +\          & ImpLive p"
  23.759 +   (fn _ => [Clarsimp_tac 1,
  23.760 +	     subgoal_tac
  23.761 +	       "sigma |= Init(ImpInit p & HInit rmhist p) \
  23.762 +\                        & [](ImpNext p) \
  23.763 +\                        & [][HNext rmhist p]_(c p, r p, m p, rmhist!p) \
  23.764 +\                        & [](!l. $MemInv mm l)" 1,
  23.765 +	     auto_tac (MI_css addsimps2 [split_box_conj,box_stp_act] addSDs2 [Step1_5_1b]),
  23.766 +	     force_tac (MI_css addsimps2 [IPImp_def,MClkIPSpec_def,RPCIPSpec_def,RPSpec_def,
  23.767 +					  ImpLive_def,c_def,r_def,m_def]) 1,
  23.768 +	     force_tac (MI_css addsimps2 [IPImp_def,MClkIPSpec_def,RPCIPSpec_def,RPSpec_def,
  23.769 +					  HistP_def,Init_def,ImpInit_def]) 1,
  23.770 +	     force_tac (MI_css addsimps2 [IPImp_def,MClkIPSpec_def,RPCIPSpec_def,RPSpec_def,
  23.771 +					  ImpNext_def,c_def,r_def,m_def,split_box_conj]) 1,
  23.772 +	     force_tac (MI_css addsimps2 [HistP_def]) 1,
  23.773 +             force_tac (MI_css addsimps2 [temp_use allT] addSDs2 [Step1_5_1a]) 1
  23.774  	    ]);
  23.775  
  23.776 -(* The implementation is infinitely often in state S1 *)
  23.777 +(* The implementation is infinitely often in state S1... *)
  23.778  qed_goal "Step1_5_3a" MemoryImplementation.thy
  23.779 -   "[](ImpNext p .& [HNext rmhist p]_<c p, r p, m p, rmhist@p>) \
  23.780 -\   .& [](RALL l. $(MemInv mem l))  \
  23.781 -\   .& []($(ImpInv rmhist p)) .& ImpLive p  \
  23.782 -\   .-> []<>($(S1 rmhist p))"
  23.783 -   (fn _ => [auto_tac (MI_css addsimps2 [ImpLive_def]),
  23.784 +   "|- [](ImpNext p & [HNext rmhist p]_(c p, r p, m p, rmhist!p)) \
  23.785 +\      & [](!l. $MemInv mm l)  \
  23.786 +\      & []($ImpInv rmhist p) & ImpLive p  \
  23.787 +\      --> []<>S1 rmhist p"
  23.788 +   (fn _ => [clarsimp_tac (MI_css addsimps2 [ImpLive_def]) 1,
  23.789               rtac S1Infinite 1,
  23.790 -	     SELECT_GOAL
  23.791 -	       (auto_tac (MI_css
  23.792 -			  addsimps2 [split_box_conj]
  23.793 -			  addSIs2 (NotS1LeadstoS6::
  23.794 -				   map temp_mp [S2_live,S3_live,S4a_live,S4b_live,S5_live]))) 1,
  23.795 -             auto_tac (MI_css addsimps2 [split_box_conj] addSIs2 [temp_mp S6_live])
  23.796 +	     force_tac (MI_css
  23.797 +			  addsimps2 [split_box_conj,box_stp_act]
  23.798 +			  addSIs2 [NotS1LeadstoS6,S2_live,S3_live,S4a_live,S4b_live,S5_live]) 1,
  23.799 +             auto_tac (MI_css addsimps2 [split_box_conj] addSIs2 [S6_live])
  23.800              ]);
  23.801  
  23.802 -(* Hence, it satisfies the fairness requirements of the specification *)
  23.803 +(* ... which implies that it satisfies the fairness requirements of the specification *)
  23.804  qed_goal "Step1_5_3b" MemoryImplementation.thy
  23.805 -   "[](ImpNext p .& [HNext rmhist p]_<c p, r p, m p, rmhist@p>) \
  23.806 -\   .& [](RALL l. $(MemInv mem l)) .& []($(ImpInv rmhist p)) .& ImpLive p  \
  23.807 -\   .-> WF(RNext memCh mem (resbar rmhist) p)_<rtrner memCh @ p, resbar rmhist @ p>"
  23.808 -   (fn _ => [ auto_tac (MI_fast_css addSIs2 [RNext_fair,temp_mp Step1_5_3a]) ]);
  23.809 +   "|- [](ImpNext p & [HNext rmhist p]_(c p, r p, m p, rmhist!p)) \
  23.810 +\      & [](!l. $MemInv mm l) & []($ImpInv rmhist p) & ImpLive p  \
  23.811 +\      --> WF(RNext memCh mm (resbar rmhist) p)_(rtrner memCh!p, resbar rmhist!p)"
  23.812 +   (fn _ => [ auto_tac (MI_css addSIs2 [RNext_fair,Step1_5_3a]) ]);
  23.813  
  23.814  qed_goal "Step1_5_3c" MemoryImplementation.thy
  23.815 -   "[](ImpNext p .& [HNext rmhist p]_<c p, r p, m p, rmhist@p>) \
  23.816 -\   .& [](RALL l. $(MemInv mem l)) .& []($(ImpInv rmhist p)) .& ImpLive p  \
  23.817 -\   .-> WF(MemReturn memCh (resbar rmhist) p)_<rtrner memCh @ p, resbar rmhist @ p>"
  23.818 -   (fn _ => [ auto_tac (MI_fast_css addSIs2 [Return_fair,temp_mp Step1_5_3a]) ]);
  23.819 +   "|- [](ImpNext p & [HNext rmhist p]_(c p, r p, m p, rmhist!p)) \
  23.820 +\      & [](!l. $MemInv mm l) & []($ImpInv rmhist p) & ImpLive p  \
  23.821 +\      --> WF(MemReturn memCh (resbar rmhist) p)_(rtrner memCh!p, resbar rmhist!p)"
  23.822 +   (fn _ => [ auto_tac (MI_css addSIs2 [Return_fair,Step1_5_3a]) ]);
  23.823  
  23.824  
  23.825  (* QED step of step 1 *)
  23.826  qed_goal "Step1" MemoryImplementation.thy
  23.827 -   "IPImp p .& HistP rmhist p .-> UPSpec memCh mem (resbar rmhist) p"
  23.828 +   "|- IPImp p & HistP rmhist p --> UPSpec memCh mm (resbar rmhist) p"
  23.829     (fn _ => [auto_tac
  23.830                 (MI_css addsimps2 [UPSpec_def,split_box_conj]
  23.831 -		       addSEs2 [temp_impE GoodImpl]
  23.832 -                       addSIs2 (map temp_mp [Step1_5_2a,Step1_5_2b,
  23.833 -                                             Step1_5_3b,Step1_5_3c]))
  23.834 +		       addSDs2 [GoodImpl]
  23.835 +                       addSIs2 [Step1_5_2a,Step1_5_2b,Step1_5_3b,Step1_5_3c])
  23.836              ]);
  23.837  
  23.838  
  23.839 @@ -602,46 +536,46 @@
  23.840  section "Step 2";
  23.841  
  23.842  qed_goal "Step2_2a" MemoryImplementation.thy
  23.843 -   "ImpNext p .& [HNext rmhist p]_<c p, r p, m p, rmhist@p> \
  23.844 -\   .& $(S4 rmhist p) .& Write rmCh mem ires p l \
  23.845 -\   .-> (S4 rmhist p)$ .& unchanged <e p, c p, r p, rmhist@p>"
  23.846 -   (fn _ => [split_idle_tac [] 1,
  23.847 -             action_simp_tac (simpset() addsimps [ImpNext_def])
  23.848 -                             [] [S4EnvUnchE,S4ClerkUnchE,S4RPCUnchE] 1,
  23.849 -             TRYALL (action_simp_tac (simpset() addsimps [square_def]) [] [S4WriteE]),
  23.850 -             Auto_tac
  23.851 +   "|- Write rmCh mm ires p l & ImpNext p & [HNext rmhist p]_(c p, r p, m p, rmhist!p) \
  23.852 +\      & $ImpInv rmhist p  \
  23.853 +\      --> (S4 rmhist p)` & unchanged (e p, c p, r p, rmhist!p)"
  23.854 +   (fn _ => [Clarsimp_tac 1,
  23.855 +             dtac (action_use WriteS4) 1, atac 1,
  23.856 +             split_idle_tac [] 1,
  23.857 +             auto_tac (MI_css addsimps2 [ImpNext_def] 
  23.858 +                              addSDs2 [S4EnvUnch,S4ClerkUnch,S4RPCUnch]),
  23.859 +             auto_tac (MI_css addsimps2 [square_def] addDs2 [S4Write])
  23.860              ]);
  23.861  
  23.862  qed_goal "Step2_2" MemoryImplementation.thy
  23.863 -   "      (RALL p. ImpNext p) \
  23.864 -\      .& (RALL p. [HNext rmhist p]_<c p, r p, m p, rmhist@p>) \
  23.865 -\      .& (RALL p. $(ImpInv rmhist p)) \
  23.866 -\      .& [REX q. Write rmCh mem ires q l]_(mem@l) \
  23.867 -\   .-> [REX q. Write memCh mem (resbar rmhist) q l]_(mem@l)"
  23.868 -   (fn _ => [auto_tac (MI_css addsimps2 [square_def]
  23.869 -                                   addSIs2 [action_mp Step1_4_4b]
  23.870 -		                   addSEs2 [WriteS4E, action_conjimpE Step2_2a])
  23.871 +   "|-   (!p. ImpNext p) \
  23.872 +\      & (!p. [HNext rmhist p]_(c p, r p, m p, rmhist!p)) \
  23.873 +\      & (!p. $ImpInv rmhist p) \
  23.874 +\      & [? q. Write rmCh mm ires q l]_(mm!l) \
  23.875 +\      --> [? q. Write memCh mm (resbar rmhist) q l]_(mm!l)"
  23.876 +   (fn _ => [auto_tac (MI_css addSIs2 [squareCI] addSEs2 [squareE]),
  23.877 +             REPEAT (ares_tac [exI, action_use Step1_4_4b] 1),
  23.878 +             force_tac (MI_css addSIs2 [WriteS4]) 1,
  23.879 +             auto_tac (MI_css addSDs2 [Step2_2a])
  23.880              ]);
  23.881  
  23.882  qed_goal "Step2_lemma" MemoryImplementation.thy
  23.883 -   "    [](   (RALL p. ImpNext p) \
  23.884 -\          .& (RALL p. [HNext rmhist p]_<c p, r p, m p, rmhist@p>) \
  23.885 -\          .& (RALL p. $(ImpInv rmhist p)) \
  23.886 -\          .& [REX q. Write rmCh mem ires q l]_(mem@l)) \
  23.887 -\   .-> [][REX q. Write memCh mem (resbar rmhist) q l]_(mem@l)"
  23.888 -   (fn _ => [ auto_tac (MI_css addSEs2 [STL4E, action_conjimpE Step2_2]) ]);
  23.889 +   "|-  [](  (!p. ImpNext p) \
  23.890 +\          & (!p. [HNext rmhist p]_(c p, r p, m p, rmhist!p)) \
  23.891 +\          & (!p. $ImpInv rmhist p) \
  23.892 +\          & [? q. Write rmCh mm ires q l]_(mm!l)) \
  23.893 +\       --> [][? q. Write memCh mm (resbar rmhist) q l]_(mm!l)"
  23.894 +   (fn _ => [ force_tac (MI_css addSEs2 [STL4E] addSDs2 [Step2_2]) 1 ]);
  23.895  
  23.896  qed_goal "Step2" MemoryImplementation.thy
  23.897 -   "#(MemLoc l) .& (RALL p. IPImp p .& HistP rmhist p)  \
  23.898 -\   .-> MSpec memCh mem (resbar rmhist) l"
  23.899 +   "|- #l : #MemLoc & (!p. IPImp p & HistP rmhist p)  \
  23.900 +\      --> MSpec memCh mm (resbar rmhist) l"
  23.901     (fn _ => [auto_tac (MI_css addsimps2 [MSpec_def]),
  23.902 -	         (* prove initial condition, don't expand IPImp in other subgoal *)
  23.903 -	     SELECT_GOAL (auto_tac (MI_css addsimps2 [IPImp_def,MSpec_def])) 1,
  23.904 -	     auto_tac (MI_css addSIs2 [temp_mp Step2_lemma]
  23.905 +	     force_tac (MI_css addsimps2 [IPImp_def,MSpec_def]) 1,
  23.906 +	     auto_tac (MI_css addSIs2 [Step2_lemma]
  23.907  		              addsimps2 [split_box_conj,all_box]),
  23.908 -	     SELECT_GOAL (auto_tac (MI_css addsimps2 [IPImp_def,MSpec_def])) 4,
  23.909 -             auto_tac (MI_css addsimps2 [split_box_conj]
  23.910 -			      addSEs2 [temp_impE GoodImpl])
  23.911 +	     force_tac (MI_css addsimps2 [IPImp_def,MSpec_def]) 4,
  23.912 +             auto_tac (MI_css addsimps2 [split_box_conj] addSEs2 [allE] addSDs2 [GoodImpl])
  23.913  	    ]);
  23.914  
  23.915  (* ----------------------------- Main theorem --------------------------------- *)
  23.916 @@ -655,18 +589,20 @@
  23.917     and history variable with explicit refinement mapping
  23.918  *)
  23.919  qed_goal "Impl_IUSpec" MemoryImplementation.thy
  23.920 -   "Implementation .& Hist rmhist .-> IUSpec memCh mem (resbar rmhist)"
  23.921 -   (fn _ => [auto_tac (MI_css addsimps2 [IUSpec_def,Impl_def,IPImp_def,MClkISpec_def,
  23.922 -					 RPCISpec_def,IRSpec_def,Hist_def]
  23.923 -		              addSIs2 (map temp_mp [Step1,Step2]))
  23.924 +   "|- Implementation & Hist rmhist --> IUSpec memCh mm (resbar rmhist)"
  23.925 +   (fn _ => [auto_tac (MI_css addsimps2 [IUSpec_def,Implementation_def,IPImp_def,
  23.926 +					 MClkISpec_def,RPCISpec_def,IRSpec_def,Hist_def]
  23.927 +		              addSIs2 [Step1,Step2])
  23.928  	    ]);
  23.929  
  23.930  (* The main theorem: introduce hiding and eliminate history variable. *)
  23.931  qed_goal "Implementation" MemoryImplementation.thy
  23.932 -   "Implementation .-> USpec memCh"
  23.933 -   (fn _ => [Auto_tac,
  23.934 -             forward_tac [temp_mp History] 1,
  23.935 +   "|- Implementation --> USpec memCh"
  23.936 +   (fn _ => [Clarsimp_tac 1,
  23.937 +             forward_tac [temp_use History] 1,
  23.938               auto_tac (MI_css addsimps2 [USpec_def] 
  23.939 -                              addIs2 (map temp_mp [eexI, Impl_IUSpec])
  23.940 +                              addIs2 [eexI, Impl_IUSpec, MI_base]
  23.941                                addSEs2 [eexE])
  23.942              ]);
  23.943 +
  23.944 +
    24.1 --- a/src/HOL/TLA/Memory/MemoryImplementation.thy	Mon Feb 08 13:02:42 1999 +0100
    24.2 +++ b/src/HOL/TLA/Memory/MemoryImplementation.thy	Mon Feb 08 13:02:56 1999 +0100
    24.3 @@ -9,7 +9,9 @@
    24.4      RPC-Memory example: Memory implementation
    24.5  *)
    24.6  
    24.7 -MemoryImplementation = Memory + RPC + MemClerk + MIParameters +
    24.8 +MemoryImplementation = Memory + RPC + MemClerk + Datatype +
    24.9 +
   24.10 +datatype  histState  =  histA | histB
   24.11  
   24.12  types
   24.13    histType  = "(PrIds => histState) stfun"     (* the type of the history variable *)
   24.14 @@ -19,8 +21,7 @@
   24.15       (* channel (external) *)
   24.16    memCh         :: "memChType"
   24.17       (* internal variables *)
   24.18 -  mem           :: "memType"
   24.19 -  resbar        :: "histType => resType"        (* defined by refinement mapping *)
   24.20 +  mm            :: "memType"
   24.21    
   24.22    (* the state variables of the implementation *)
   24.23       (* channels *)
   24.24 @@ -28,7 +29,7 @@
   24.25    crCh          :: "rpcSndChType"
   24.26    rmCh          :: "rpcRcvChType"
   24.27       (* internal variables *)
   24.28 -  (* identity refinement mapping for mem -- simply reused *)
   24.29 +  (* identity refinement mapping for mm -- simply reused *)
   24.30    rst           :: "rpcStType"
   24.31    cst           :: "mClkStType"
   24.32    ires          :: "resType"
   24.33 @@ -36,153 +37,145 @@
   24.34    rmhist        :: "histType"
   24.35  *)
   24.36  
   24.37 +constdefs
   24.38 +  (* auxiliary predicates *)
   24.39 +  MVOKBARF      :: "Vals => bool"
   24.40 +     "MVOKBARF v == (v : MemVal) | (v = OK) | (v = BadArg) | (v = RPCFailure)"
   24.41 +  MVOKBA        :: "Vals => bool"
   24.42 +     "MVOKBA v   == (v : MemVal) | (v = OK) | (v = BadArg)"
   24.43 +  MVNROKBA      :: "Vals => bool"
   24.44 +     "MVNROKBA v == (v : MemVal) | (v = NotAResult) | (v = OK) | (v = BadArg)"
   24.45 +
   24.46 +  (* tuples of state functions changed by the various components *)
   24.47 +  e             :: "PrIds => (bit * memOp) stfun"
   24.48 +     "e p == PRED (caller memCh!p)"
   24.49 +  c             :: "PrIds => (mClkState * (bit * Vals) * (bit * rpcOp)) stfun"
   24.50 +     "c p == PRED (cst!p, rtrner memCh!p, caller crCh!p)"
   24.51 +  r             :: "PrIds => (rpcState * (bit * Vals) * (bit * memOp)) stfun"
   24.52 +     "r p == PRED (rst!p, rtrner crCh!p, caller rmCh!p)"
   24.53 +  m             :: "PrIds => ((bit * Vals) * Vals) stfun"
   24.54 +     "m p == PRED (rtrner rmCh!p, ires!p)"
   24.55 +
   24.56    (* the environment action *)
   24.57    ENext         :: "PrIds => action"
   24.58 +     "ENext p == ACT (? l. #l : #MemLoc & Call memCh p #(read l))"
   24.59 +
   24.60  
   24.61    (* specification of the history variable *)
   24.62    HInit         :: "histType => PrIds => stpred"
   24.63 +     "HInit rmhist p == PRED rmhist!p = #histA"
   24.64 +
   24.65    HNext         :: "histType => PrIds => action"
   24.66 +     "HNext rmhist p == ACT (rmhist!p)$ =
   24.67 +                     (if (MemReturn rmCh ires p | RPCFail crCh rmCh rst p)
   24.68 +                      then #histB
   24.69 +                      else if (MClkReply memCh crCh cst p)
   24.70 +                           then #histA
   24.71 +                           else $(rmhist!p))"
   24.72 +
   24.73    HistP         :: "histType => PrIds => temporal"
   24.74 +     "HistP rmhist p == TEMP Init HInit rmhist p
   24.75 +                           & [][HNext rmhist p]_(c p,r p,m p, rmhist!p)"
   24.76 +
   24.77    Hist          :: "histType => temporal"
   24.78 +      "Hist rmhist == TEMP (!p. HistP rmhist p)"
   24.79  
   24.80    (* the implementation *)
   24.81 +  IPImp          :: "PrIds => temporal"
   24.82 +     "IPImp p == TEMP (  Init ~Calling memCh p & [][ENext p]_(e p)
   24.83 +	               & MClkIPSpec memCh crCh cst p
   24.84 +  	               & RPCIPSpec crCh rmCh rst p
   24.85 +	               & RPSpec rmCh mm ires p
   24.86 +		       & (! l. #l : #MemLoc --> MSpec rmCh mm ires l))"
   24.87 +
   24.88    ImpInit        :: "PrIds => stpred"
   24.89 +      "ImpInit p == PRED (  ~Calling memCh p
   24.90 +                          & MClkInit crCh cst p
   24.91 +	                  & RPCInit rmCh rst p
   24.92 +	                  & PInit ires p)"
   24.93 +
   24.94    ImpNext        :: "PrIds => action"
   24.95 +      "ImpNext p == ACT  [ENext p]_(e p) 
   24.96 +                       & [MClkNext memCh crCh cst p]_(c p)
   24.97 +                       & [RPCNext crCh rmCh rst p]_(r p) 
   24.98 +                       & [RNext rmCh mm ires p]_(m p)"
   24.99 +
  24.100    ImpLive        :: "PrIds => temporal"
  24.101 -  IPImp          :: "PrIds => temporal"
  24.102 +      "ImpLive p == TEMP  WF(MClkFwd memCh crCh cst p)_(c p) 
  24.103 +			& SF(MClkReply memCh crCh cst p)_(c p)
  24.104 +			& WF(RPCNext crCh rmCh rst p)_(r p) 
  24.105 +			& WF(RNext rmCh mm ires p)_(m p)
  24.106 +			& WF(MemReturn rmCh ires p)_(m p)"
  24.107 +
  24.108    Implementation :: "temporal"
  24.109 -  ImpInv         :: "histType => PrIds => stpred"
  24.110 -
  24.111 -  (* tuples of state functions changed by the various components *)
  24.112 -  e             :: "PrIds => (bit * memArgType) stfun"
  24.113 -  c             :: "PrIds => (mClkState * (bit * Vals) * (bit * rpcArgType)) stfun"
  24.114 -  r             :: "PrIds => (rpcState * (bit * Vals) * (bit * memArgType)) stfun"
  24.115 -  m             :: "PrIds => ((bit * Vals) * Vals) stfun"
  24.116 +      "Implementation == TEMP ( (!p. Init (~Calling memCh p) & [][ENext p]_(e p))
  24.117 +                               & MClkISpec memCh crCh cst
  24.118 +                               & RPCISpec crCh rmCh rst
  24.119 +                               & IRSpec rmCh mm ires)"
  24.120  
  24.121    (* the predicate S describes the states of the implementation.
  24.122 -     slight simplification: two "histState" parameters instead of a (one- or
  24.123 -     two-element) set. *)
  24.124 -  S             :: "histType => bool => bool => bool => mClkState => rpcState => histState => histState => PrIds => stpred"
  24.125 +     slight simplification: two "histState" parameters instead of a
  24.126 +     (one- or two-element) set.
  24.127 +     NB: The second conjunct of the definition in the paper is taken care of by
  24.128 +     the type definitions. The last conjunct is asserted separately as the memory
  24.129 +     invariant MemInv, proved in Memory.ML. *)
  24.130 +  S :: "histType => bool => bool => bool => mClkState => rpcState => histState => histState => PrIds => stpred"
  24.131 +      "S rmhist ecalling ccalling rcalling cs rs hs1 hs2 p == PRED
  24.132 +                Calling memCh p = #ecalling
  24.133 +              & Calling crCh p  = #ccalling
  24.134 +              & (#ccalling --> arg<crCh!p> = MClkRelayArg<arg<memCh!p>>)
  24.135 +              & (~ #ccalling & cst!p = #clkB --> MVOKBARF<res<crCh!p>>)
  24.136 +              & Calling rmCh p  = #rcalling
  24.137 +              & (#rcalling --> arg<rmCh!p> = RPCRelayArg<arg<crCh!p>>)
  24.138 +              & (~ #rcalling --> ires!p = #NotAResult)
  24.139 +              & (~ #rcalling & rst!p = #rpcB --> MVOKBA<res<rmCh!p>>)
  24.140 +              & cst!p = #cs
  24.141 +              & rst!p = #rs
  24.142 +              & (rmhist!p = #hs1 | rmhist!p = #hs2)
  24.143 +              & MVNROKBA<ires!p>"
  24.144  
  24.145    (* predicates S1 -- S6 define special instances of S *)
  24.146    S1            :: "histType => PrIds => stpred"
  24.147 +      "S1 rmhist p == S rmhist False False False clkA rpcA histA histA p"
  24.148    S2            :: "histType => PrIds => stpred"
  24.149 +      "S2 rmhist p == S rmhist True False False clkA rpcA histA histA p"
  24.150    S3            :: "histType => PrIds => stpred"
  24.151 +      "S3 rmhist p == S rmhist True True False clkB rpcA histA histB p"
  24.152    S4            :: "histType => PrIds => stpred"
  24.153 +      "S4 rmhist p == S rmhist True True True clkB rpcB histA histB p"
  24.154    S5            :: "histType => PrIds => stpred"
  24.155 +      "S5 rmhist p == S rmhist True True False clkB rpcB histB histB p"
  24.156    S6            :: "histType => PrIds => stpred"
  24.157 +      "S6 rmhist p == S rmhist True False False clkB rpcA histB histB p"
  24.158  
  24.159 -  (* auxiliary predicates *)
  24.160 -  MVOKBARF      :: "Vals => bool"
  24.161 -  MVOKBA        :: "Vals => bool"
  24.162 -  MVNROKBA      :: "Vals => bool"
  24.163 +  (* The invariant asserts that the system is always in one of S1 - S6, for every p *)
  24.164 +  ImpInv         :: "histType => PrIds => stpred"
  24.165 +      "ImpInv rmhist p == PRED (  S1 rmhist p | S2 rmhist p | S3 rmhist p
  24.166 +				| S4 rmhist p | S5 rmhist p | S6 rmhist p)"
  24.167 +
  24.168 +  resbar        :: "histType => resType"        (* refinement mapping *)
  24.169 +      "resbar rmhist s p == 
  24.170 +                  (if (S1 rmhist p s | S2 rmhist p s)
  24.171 +                   then ires s p
  24.172 +                   else if S3 rmhist p s
  24.173 +                   then if rmhist s p = histA 
  24.174 +                        then ires s p else MemFailure
  24.175 +                   else if S4 rmhist p s
  24.176 +                   then if (rmhist s p = histB & ires s p = NotAResult)
  24.177 +                        then MemFailure else ires s p
  24.178 +                   else if S5 rmhist p s
  24.179 +                   then res (rmCh s p)
  24.180 +                   else if S6 rmhist p s
  24.181 +                   then if res (crCh s p) = RPCFailure
  24.182 +                        then MemFailure else res (crCh s p)
  24.183 +                   else NotAResult)" (* dummy value *)
  24.184  
  24.185  rules
  24.186 -  MVOKBARF_def  "MVOKBARF v == (MemVal v) | (v = OK) | (v = BadArg) | (v = RPCFailure)"
  24.187 -  MVOKBA_def    "MVOKBA v   == (MemVal v) | (v = OK) | (v = BadArg)"
  24.188 -  MVNROKBA_def  "MVNROKBA v == (MemVal v) | (v = NotAResult) | (v = OK) | (v = BadArg)"
  24.189 -
  24.190    (* the "base" variables: everything except resbar and hist (for any index) *)
  24.191 -  MI_base       "base_var <caller memCh @ p, rtrner memCh @ p, 
  24.192 -                           caller crCh @ p, rtrner crCh @ p,
  24.193 -                           caller rmCh @ p, rtrner rmCh @ p,
  24.194 -                           rst@p, cst@p, mem@l, ires@p>"
  24.195 -
  24.196 -  (* Environment's next-state relation *)
  24.197 -  ENext_def     "ENext p == REX l. #(MemLoc l) .& Call memCh p (#(Inl (read,l)))"
  24.198 -
  24.199 -  (* Specification of the history variable used in the proof *)
  24.200 -  HInit_def     "$(HInit rmhist p) .= ($(rmhist@p) .= #histA)"
  24.201 -  HNext_def     "HNext rmhist p == 
  24.202 -                   (rmhist@p)$ .=
  24.203 -                     (.if (MemReturn rmCh ires p .| RPCFail crCh rmCh rst p)
  24.204 -                      .then #histB
  24.205 -                      .else .if (MClkReply memCh crCh cst p)
  24.206 -                            .then #histA
  24.207 -                            .else $(rmhist@p))"
  24.208 -  HistP_def     "HistP rmhist p == 
  24.209 -                    Init($(HInit rmhist p))
  24.210 -                    .& [][HNext rmhist p]_<c p,r p,m p, rmhist@p>"
  24.211 -  Hist_def      "Hist rmhist == RALL p. HistP rmhist p"
  24.212 -
  24.213 -  (* definitions of e,c,r,m *)
  24.214 -  e_def         "e p == caller memCh @ p"
  24.215 -  c_def         "c p == <cst@p, rtrner memCh @ p, caller crCh @ p>"
  24.216 -  r_def         "r p == <rst@p, rtrner crCh @ p, caller rmCh @ p>"
  24.217 -  m_def         "m p == <rtrner rmCh @ p, ires@p>"
  24.218 -
  24.219 -  (* definition of the implementation (without the history variable) *)
  24.220 -  IPImp_def     "IPImp p ==    Init(.~ $(Calling memCh p)) .& [][ENext p]_(e p)
  24.221 -			           .& MClkIPSpec memCh crCh cst p
  24.222 -			           .& RPCIPSpec crCh rmCh rst p
  24.223 -			           .& RPSpec rmCh mem ires p 
  24.224 -			           .& (RALL l. #(MemLoc l) .-> MSpec rmCh mem ires l)"
  24.225 -
  24.226 -  ImpInit_def   "$(ImpInit p) .= (   .~ $(Calling memCh p)    \
  24.227 -\		                  .& $(MClkInit crCh cst p)   \
  24.228 -\		                  .& $(RPCInit rmCh rst p)   \
  24.229 -\		                  .& $(PInit ires p))"
  24.230 -
  24.231 -  ImpNext_def   "ImpNext p ==   [ENext p]_(e p) 
  24.232 -                             .& [MClkNext memCh crCh cst p]_(c p)
  24.233 -                             .& [RPCNext crCh rmCh rst p]_(r p) 
  24.234 -                             .& [RNext rmCh mem ires p]_(m p)"
  24.235 -
  24.236 -  ImpLive_def  "ImpLive p ==   WF(MClkFwd memCh crCh cst p)_(c p) 
  24.237 -			    .& SF(MClkReply memCh crCh cst p)_(c p)
  24.238 -			    .& WF(RPCNext crCh rmCh rst p)_(r p) 
  24.239 -			    .& WF(RNext rmCh mem ires p)_(m p)
  24.240 -			    .& WF(MemReturn rmCh ires p)_(m p)"
  24.241 -
  24.242 -  Impl_def   "Implementation ==    (RALL p. Init(.~ $(Calling memCh p)) .& [][ENext p]_(e p))
  24.243 -                                .& MClkISpec memCh crCh cst
  24.244 -                                .& RPCISpec crCh rmCh rst
  24.245 -                                .& IRSpec rmCh mem ires"
  24.246 -
  24.247 -  ImpInv_def "$(ImpInv rmhist p) .= ($(S1 rmhist p) .| $(S2 rmhist p) .| $(S3 rmhist p) .| 
  24.248 -                                     $(S4 rmhist p) .| $(S5 rmhist p) .| $(S6 rmhist p))"
  24.249 -
  24.250 -  (* Definition of predicate S.
  24.251 -     NB: The second conjunct of the definition in the paper is taken care of by
  24.252 -     the type definitions. The last conjunct is asserted separately as the memory
  24.253 -     invariant MemInv, proved in Memory.ML. *)
  24.254 -  S_def    "$(S rmhist ecalling ccalling rcalling cs rs hs1 hs2 p) .=
  24.255 -              (  ($(Calling memCh p) .= # ecalling)
  24.256 -              .& ($(Calling crCh p) .= # ccalling)
  24.257 -              .& (# ccalling .-> (arg[ $(crCh@p)] .= MClkRelayArg[ arg[$(memCh@p)] ]))
  24.258 -              .& ((.~ # ccalling .& ($(cst@p) .= # clkB)) .-> MVOKBARF[ res[$(crCh@p)] ])
  24.259 -              .& ($(Calling rmCh p) .= # rcalling)
  24.260 -              .& (# rcalling .-> (arg[ $(rmCh@p)] .= RPCRelayArg[ arg[$(crCh@p)] ]))
  24.261 -              .& (.~ # rcalling .-> ($(ires@p) .= # NotAResult))
  24.262 -              .& ((.~ # rcalling .& ($(rst@p) .= # rpcB)) .-> MVOKBA[ res[$(rmCh@p)] ])
  24.263 -              .& ($(cst@p) .= # cs)
  24.264 -              .& ($(rst@p) .= # rs)
  24.265 -              .& (($(rmhist@p) .= #hs1) .| ($(rmhist@p) .= #hs2))
  24.266 -              .& (MVNROKBA[ $(ires@p)]))"
  24.267 -
  24.268 -  S1_def   "$(S1 rmhist p) .= $(S rmhist False False False clkA rpcA histA histA p)"
  24.269 -  S2_def   "$(S2 rmhist p) .= $(S rmhist True False False clkA rpcA histA histA p)"
  24.270 -  S3_def   "$(S3 rmhist p) .= $(S rmhist True True False clkB rpcA histA histB p)"
  24.271 -  S4_def   "$(S4 rmhist p) .= $(S rmhist True True True clkB rpcB histA histB p)"
  24.272 -  S5_def   "$(S5 rmhist p) .= $(S rmhist True True False clkB rpcB histB histB p)"
  24.273 -  S6_def   "$(S6 rmhist p) .= $(S rmhist True False False clkB rpcA histB histB p)"
  24.274 -
  24.275 -  (* Definition of the refinement mapping resbar for result *)
  24.276 -  resbar_def   "$((resbar rmhist) @ p) .=
  24.277 -                  (.if ($(S1 rmhist p) .| $(S2 rmhist p))
  24.278 -                   .then $(ires@p)
  24.279 -                   .else .if $(S3 rmhist p)
  24.280 -                   .then .if $(rmhist@p) .= #histA 
  24.281 -                         .then $(ires@p) .else # MemFailure
  24.282 -                   .else .if $(S4 rmhist p)
  24.283 -                   .then .if ($(rmhist@p) .= #histB) .& ($(ires@p) .= # NotAResult)
  24.284 -                         .then #MemFailure .else $(ires@p)
  24.285 -                   .else .if $(S5 rmhist p)
  24.286 -                   .then res[$(rmCh@p)]
  24.287 -                   .else .if $(S6 rmhist p)
  24.288 -                   .then .if res[$(crCh@p)] .= #RPCFailure
  24.289 -                         .then #MemFailure .else res[$(crCh@p)]
  24.290 -                   .else #NotAResult)" (* dummy value *)
  24.291 +  MI_base       "basevars (caller memCh!p,
  24.292 +			   (rtrner memCh!p, caller crCh!p, cst!p),
  24.293 +			   (rtrner crCh!p, caller rmCh!p, rst!p),
  24.294 +			   (mm!l, rtrner rmCh!p, ires!p))"
  24.295  
  24.296  end
  24.297  
    25.1 --- a/src/HOL/TLA/Memory/MemoryParameters.ML	Mon Feb 08 13:02:42 1999 +0100
    25.2 +++ b/src/HOL/TLA/Memory/MemoryParameters.ML	Mon Feb 08 13:02:56 1999 +0100
    25.3 @@ -6,19 +6,24 @@
    25.4      RPC-Memory example: memory parameters (ML file)
    25.5  *)
    25.6  
    25.7 +(*
    25.8  val MP_simps = [BadArgNoMemVal,MemFailNoMemVal,InitValMemVal,NotAResultNotVal,
    25.9                    NotAResultNotOK, NotAResultNotBA, NotAResultNotMF]
   25.10                 @ (map (fn x => x RS not_sym) 
   25.11                        [NotAResultNotOK, NotAResultNotBA, NotAResultNotMF]);
   25.12 +*)
   25.13  
   25.14 +Addsimps ([BadArgNoMemVal,MemFailNoMemVal,InitValMemVal,NotAResultNotVal,
   25.15 +                  NotAResultNotOK, NotAResultNotBA, NotAResultNotMF]
   25.16 +               @ (map (fn x => x RS not_sym) 
   25.17 +                      [NotAResultNotOK, NotAResultNotBA, NotAResultNotMF]));
   25.18  
   25.19  (* Auxiliary rules *)
   25.20  
   25.21  qed_goal "MemValNotAResultE" MemoryParameters.thy
   25.22 -   "[| MemVal x; (x ~= NotAResult ==> P) |] ==> P"
   25.23 -   (fn [min,maj] => [rtac maj 1,
   25.24 -                     case_tac "x = NotAResult" 1,
   25.25 -                     cut_facts_tac [min,NotAResultNotVal] 1,
   25.26 -                     ALLGOALS Asm_full_simp_tac
   25.27 -                    ]);
   25.28 +   "[| x : MemVal; (x ~= NotAResult ==> P) |] ==> P"
   25.29 +   (fn prems => [resolve_tac prems 1,
   25.30 +                 cut_facts_tac (NotAResultNotVal::prems) 1,
   25.31 +                 Force_tac 1
   25.32 +                ]);
   25.33  
    26.1 --- a/src/HOL/TLA/Memory/MemoryParameters.thy	Mon Feb 08 13:02:42 1999 +0100
    26.2 +++ b/src/HOL/TLA/Memory/MemoryParameters.thy	Mon Feb 08 13:02:56 1999 +0100
    26.3 @@ -11,21 +11,24 @@
    26.4  
    26.5  MemoryParameters = Datatype + RPCMemoryParams +
    26.6  
    26.7 -(* the memory operations. nb: data types must be defined in theories
    26.8 -   that do not include Intensional -- otherwise the induction rule
    26.9 -   can't be type-checked unambiguously.
   26.10 -*)
   26.11 +(* the memory operations *)
   26.12 +(***
   26.13  datatype  Rd = read
   26.14  datatype  Wr = write
   26.15 +***)
   26.16  
   26.17 +datatype memOp = read Locs | write Locs Vals
   26.18 +
   26.19 +(***
   26.20  types
   26.21    (* legal arguments for the memory *)
   26.22    memArgType = "(Rd * Locs) + (Wr * Locs * Vals)"
   26.23 +***)
   26.24  
   26.25  consts
   26.26    (* memory locations and contents *)
   26.27 -  MemLoc         :: "Locs => bool"
   26.28 -  MemVal         :: "Vals => bool"
   26.29 +  MemLoc         :: Locs set
   26.30 +  MemVal         :: Vals set
   26.31  
   26.32    (* some particular values *)
   26.33    OK             :: "Vals"
   26.34 @@ -38,13 +41,11 @@
   26.35  
   26.36  rules
   26.37    (* basic assumptions about the above constants and predicates *)
   26.38 -  BadArgNoMemVal    "~MemVal(BadArg)"
   26.39 -  MemFailNoMemVal   "~MemVal(MemFailure)"
   26.40 -  InitValMemVal     "MemVal(InitVal)"
   26.41 -  NotAResultNotVal  "~MemVal(NotAResult)"
   26.42 +  BadArgNoMemVal    "BadArg ~: MemVal"
   26.43 +  MemFailNoMemVal   "MemFailure ~: MemVal"
   26.44 +  InitValMemVal     "InitVal : MemVal"
   26.45 +  NotAResultNotVal  "NotAResult ~: MemVal"
   26.46    NotAResultNotOK   "NotAResult ~= OK"
   26.47    NotAResultNotBA   "NotAResult ~= BadArg"
   26.48    NotAResultNotMF   "NotAResult ~= MemFailure"
   26.49  end
   26.50 -
   26.51 -
    27.1 --- a/src/HOL/TLA/Memory/ProcedureInterface.ML	Mon Feb 08 13:02:42 1999 +0100
    27.2 +++ b/src/HOL/TLA/Memory/ProcedureInterface.ML	Mon Feb 08 13:02:56 1999 +0100
    27.3 @@ -3,14 +3,15 @@
    27.4      Author:      Stephan Merz
    27.5      Copyright:   1997 University of Munich
    27.6  
    27.7 -    Procedure interface (ML file)
    27.8 +    Procedure interface (theorems and proofs)
    27.9  *)
   27.10  
   27.11  Addsimps [slice_def];
   27.12 +val mem_css = (claset(), simpset());
   27.13  
   27.14  (* ---------------------------------------------------------------------------- *)
   27.15  
   27.16 -val Procedure_defs = [caller_def, rtrner_def, action_rewrite Calling_def, 
   27.17 +val Procedure_defs = [caller_def, rtrner_def, Calling_def, 
   27.18                        Call_def, Return_def,
   27.19  		      PLegalCaller_def, LegalCaller_def,
   27.20  		      PLegalReturner_def, LegalReturner_def];
   27.21 @@ -18,22 +19,29 @@
   27.22  (* sample theorems (not used in the proof):
   27.23     1. calls and returns are mutually exclusive
   27.24  
   27.25 -qed_goal "CallReturnMutex" ProcedureInterface.thy
   27.26 -     "Call ch p v .-> .~ Return ch p w"
   27.27 -  (fn prems => [ auto_tac (action_css addsimps2 [Call_def,Return_def]) ]);
   27.28 +qed_goal "CallNotReturn" ProcedureInterface.thy
   27.29 +     "|- Call ch p v --> ~ Return ch p w"
   27.30 +  (fn prems => [ auto_tac (temp_css addsimps2 [Call_def,Return_def]) ]);
   27.31  
   27.32  
   27.33    2. enabledness of calls and returns
   27.34 -     NB: action_simp_tac is significantly faster than auto_tac
   27.35  
   27.36  qed_goal "Call_enabled" ProcedureInterface.thy
   27.37 -   "!!p. base_var ((caller ch)@p) ==> (.~ $(Calling ch p) .-> $(Enabled (Call ch p (#v))))"
   27.38 +   "!!p. basevars ((caller ch)!p) ==> |- ~ Calling ch p --> Enabled (Call ch p v)"
   27.39     (fn _ => [action_simp_tac (simpset() addsimps [caller_def, Call_def]) 
   27.40                               [] [base_enabled,Pair_inject] 1
   27.41              ]);
   27.42  
   27.43 +qed_goal "Call_enabled_rew" ProcedureInterface.thy
   27.44 +   "basevars ((caller ch)!p) ==> |- Enabled (Call ch p v) = (~Calling ch p)"
   27.45 +   (fn [prem] => [auto_tac (mem_css addsimps2 [Call_def]),
   27.46 +                  force_tac (mem_css addsimps2 [enabled_def]) 1,
   27.47 +                  enabled_tac prem 1,
   27.48 +                  action_simp_tac (simpset() addsimps [caller_def]) [] [Pair_inject] 1
   27.49 +            ]);
   27.50 +
   27.51  qed_goal "Return_enabled" ProcedureInterface.thy
   27.52 -   "!!p. base_var ((rtrner ch)@p) ==> $(Calling ch p) .-> $(Enabled (Return ch p (#v)))"
   27.53 +   "!!p. basevars ((rtrner ch)!p) ==> |- Calling ch p --> Enabled (Return ch p v)"
   27.54     (fn _ => [action_simp_tac (simpset() addsimps [rtrner_def, Return_def]) 
   27.55                               [] [base_enabled,Pair_inject] 1
   27.56              ]);
   27.57 @@ -42,21 +50,11 @@
   27.58  
   27.59  (* Calls and returns change their subchannel *)
   27.60  qed_goal "Call_changed" ProcedureInterface.thy
   27.61 -   "Call ch p v .-> <Call ch p v>_((caller ch)@p)"
   27.62 -   (fn _ => [auto_tac (claset(),
   27.63 -		       simpset() addsimps [angle_def,Call_def,caller_def,
   27.64 -					  action_rewrite Calling_def])
   27.65 -	    ]);
   27.66 +   "|- Call ch p v --> <Call ch p v>_((caller ch)!p)"
   27.67 +   (fn _ => [ auto_tac (mem_css addsimps2 [angle_def,Call_def,caller_def,Calling_def]) ]);
   27.68  
   27.69  qed_goal "Return_changed" ProcedureInterface.thy
   27.70 -   "Return ch p v .-> <Return ch p v>_((rtrner ch)@p)"
   27.71 -   (fn _ => [auto_tac (claset(),
   27.72 -		       simpset() addsimps [angle_def,Return_def,rtrner_def,
   27.73 -					  action_rewrite Calling_def])
   27.74 -	    ]);
   27.75 +   "|- Return ch p v --> <Return ch p v>_((rtrner ch)!p)"
   27.76 +   (fn _ => [ auto_tac (mem_css addsimps2 [angle_def,Return_def,rtrner_def,Calling_def]) ]);
   27.77  
   27.78 -(* For convenience, generate elimination rules. 
   27.79 -   These rules loop if angle_def is active! *)
   27.80 -bind_thm("Call_changedE", action_impE Call_changed);
   27.81 -bind_thm("Return_changedE", action_impE Return_changed);
   27.82  
    28.1 --- a/src/HOL/TLA/Memory/ProcedureInterface.thy	Mon Feb 08 13:02:42 1999 +0100
    28.2 +++ b/src/HOL/TLA/Memory/ProcedureInterface.thy	Mon Feb 08 13:02:56 1999 +0100
    28.3 @@ -29,9 +29,6 @@
    28.4    arg           :: "('a,'r) chan => 'a"
    28.5    res           :: "('a,'r) chan => 'r"
    28.6  
    28.7 -  (* slice through array-valued state function *)
    28.8 -  "@"           :: "('a => 'b) stfun => 'a => 'b stfun"   (infixl 20)
    28.9 -
   28.10    (* state functions *)
   28.11    caller	:: "('a,'r) channel => (PrIds => (bit * 'a)) stfun"
   28.12    rtrner        :: "('a,'r) channel => (PrIds => (bit * 'r)) stfun"
   28.13 @@ -40,8 +37,8 @@
   28.14    Calling   :: "('a,'r) channel => PrIds => stpred"
   28.15  
   28.16    (* actions *)
   28.17 -  Call      :: "('a,'r) channel => PrIds => 'a trfct => action"
   28.18 -  Return    :: "('a,'r) channel => PrIds => 'r trfct => action"
   28.19 +  ACall      :: "('a,'r) channel => PrIds => 'a stfun => action"
   28.20 +  AReturn    :: "('a,'r) channel => PrIds => 'r stfun => action"
   28.21  
   28.22    (* temporal formulas *)
   28.23    PLegalCaller      :: "('a,'r) channel => PrIds => temporal"
   28.24 @@ -49,27 +46,42 @@
   28.25    PLegalReturner    :: "('a,'r) channel => PrIds => temporal"
   28.26    LegalReturner     :: "('a,'r) channel => temporal"
   28.27  
   28.28 -rules
   28.29 -  slice_def     "(x@i) s == x s i"
   28.30 +  (* slice through array-valued state function *)
   28.31 +  slice        :: "('a => 'b) stfun => 'a => 'b stfun"
   28.32 +
   28.33 +syntax
   28.34 +  "_slice"     :: [lift, 'a] => lift       ("(_!_)" [70,70] 70)
   28.35 +
   28.36 +  "_Call"     :: ['a, 'b, lift] => lift    ("(Call _ _ _)" [90,90,90] 90)
   28.37 +  "_Return"   :: ['a, 'b, lift] => lift    ("(Return _ _ _)" [90,90,90] 90)
   28.38  
   28.39 -  caller_def	"caller ch s p   == (cbit (ch s p), arg (ch s p))"
   28.40 -  rtrner_def	"rtrner ch s p   == (rbit (ch s p), res (ch s p))"
   28.41 +translations
   28.42 +  "_slice"  ==  "slice"
   28.43 +
   28.44 +  "_Call"   ==  "ACall"
   28.45 +  "_Return" ==  "AReturn"
   28.46 +
   28.47 +rules
   28.48 +  slice_def     "(PRED (x!i)) s == x s i"
   28.49  
   28.50 -  Calling_def	"$(Calling ch p)  .= (cbit[$(ch@p)] .~= rbit[$(ch@p)])"
   28.51 -  Call_def      "Call ch p v   == .~ $(Calling ch p)
   28.52 -                                  .& (cbit[$(ch@p)])` .~= rbit[$(ch@p)]
   28.53 -                                  .& (arg[$(ch@p)])` .= v"
   28.54 -  Return_def    "Return ch p v == $(Calling ch p)
   28.55 -                                  .& (rbit[$(ch@p)])` .= cbit[$(ch@p)]
   28.56 -                                  .& (res[$(ch@p)])` .= v"
   28.57 +  caller_def	"caller ch   == %s p. (cbit (ch s p), arg (ch s p))"
   28.58 +  rtrner_def	"rtrner ch   == %s p. (rbit (ch s p), res (ch s p))"
   28.59  
   28.60 -  PLegalCaller_def      "PLegalCaller ch p ==
   28.61 -                             Init(.~ $(Calling ch p))
   28.62 -                             .& [][ REX a. Call ch p (#a) ]_((caller ch)@p)"
   28.63 -  LegalCaller_def       "LegalCaller ch == RALL p. PLegalCaller ch p"
   28.64 -  PLegalReturner_def    "PLegalReturner ch p ==
   28.65 -                                [][ REX v. Return ch p (#v) ]_((rtrner ch)@p)"
   28.66 -  LegalReturner_def     "LegalReturner ch == RALL p. PLegalReturner ch p"
   28.67 +  Calling_def	"Calling ch p  == PRED cbit< ch!p > ~= rbit< ch!p >"
   28.68 +  Call_def      "(ACT Call ch p v)   == ACT  ~ $Calling ch p
   28.69 +                                     & (cbit<ch!p>` ~= $rbit<ch!p>)
   28.70 +                                     & (arg<ch!p>` = $v)"
   28.71 +  Return_def    "(ACT Return ch p v) == ACT  $Calling ch p
   28.72 +                                     & (rbit<ch!p>` = $cbit<ch!p>)
   28.73 +                                     & (res<ch!p>` = $v)"
   28.74 +  PLegalCaller_def      "PLegalCaller ch p == TEMP
   28.75 +                             Init(~ Calling ch p)
   28.76 +                             & [][ ? a. Call ch p a ]_((caller ch)!p)"
   28.77 +  LegalCaller_def       "LegalCaller ch == TEMP (! p. PLegalCaller ch p)"
   28.78 +  PLegalReturner_def    "PLegalReturner ch p == TEMP
   28.79 +                                [][ ? v. Return ch p v ]_((rtrner ch)!p)"
   28.80 +  LegalReturner_def     "LegalReturner ch == TEMP (! p. PLegalReturner ch p)"
   28.81  
   28.82  end
   28.83  
   28.84 +
    29.1 --- a/src/HOL/TLA/Memory/ROOT.ML	Mon Feb 08 13:02:42 1999 +0100
    29.2 +++ b/src/HOL/TLA/Memory/ROOT.ML	Mon Feb 08 13:02:56 1999 +0100
    29.3 @@ -1,2 +1,2 @@
    29.4  
    29.5 -use_thy "Memory";
    29.6 +use_thy "MemoryImplementation";
    30.1 --- a/src/HOL/TLA/Memory/RPC.ML	Mon Feb 08 13:02:42 1999 +0100
    30.2 +++ b/src/HOL/TLA/Memory/RPC.ML	Mon Feb 08 13:02:56 1999 +0100
    30.3 @@ -3,57 +3,54 @@
    30.4      Author:      Stephan Merz
    30.5      Copyright:   1997 University of Munich
    30.6  
    30.7 -    RPC-Memory example: RPC specification (ML file)
    30.8 +    RPC-Memory example: RPC specification (theorems and proofs)
    30.9  *)
   30.10  
   30.11 -val RPC_action_defs = 
   30.12 -   [RPCInit_def RS inteq_reflection]
   30.13 -   @ [RPCFwd_def, RPCReject_def, RPCFail_def, RPCReply_def, RPCNext_def];
   30.14 +val RPC_action_defs = [RPCInit_def, RPCFwd_def, RPCReject_def, RPCFail_def, 
   30.15 +                       RPCReply_def, RPCNext_def];
   30.16  
   30.17  val RPC_temp_defs = [RPCIPSpec_def, RPCISpec_def];
   30.18  
   30.19 +val mem_css = (claset(), simpset());
   30.20 +
   30.21  (* The RPC component engages in an action for process p only if there is an outstanding,
   30.22     unanswered call for that process.
   30.23  *)
   30.24  
   30.25  qed_goal "RPCidle" RPC.thy
   30.26 -   ".~ $(Calling send p) .-> .~ RPCNext send rcv rst p"
   30.27 -   (fn _ => [ auto_tac (action_css addsimps2 (Return_def::RPC_action_defs)) ]);
   30.28 +   "|- ~$(Calling send p) --> ~RPCNext send rcv rst p"
   30.29 +   (fn _ => [ auto_tac (mem_css addsimps2 (Return_def::RPC_action_defs)) ]);
   30.30  
   30.31  qed_goal "RPCbusy" RPC.thy
   30.32 -   "$(Calling rcv p) .& ($(rst@p) .= #rpcB) .-> .~ RPCNext send rcv rst p"
   30.33 -   (fn _ => [ auto_tac (action_css addsimps2 (RP_simps @ RPC_action_defs)) ]);
   30.34 -
   30.35 -(* unlifted versions as introduction rules *)
   30.36 -
   30.37 -bind_thm("RPCidleI", action_mp RPCidle);
   30.38 -bind_thm("RPCbusyI", action_mp RPCbusy);
   30.39 +   "|- $(Calling rcv p) & $(rst!p) = #rpcB --> ~RPCNext send rcv rst p"
   30.40 +   (fn _ => [ auto_tac (mem_css addsimps2 RPC_action_defs) ]);
   30.41  
   30.42  (* RPC failure actions are visible. *)
   30.43  qed_goal "RPCFail_vis" RPC.thy
   30.44 -   "RPCFail send rcv rst p .-> <RPCNext send rcv rst p>_<rst@p, rtrner send @ p, caller rcv @ p>"
   30.45 -   (fn _ => [auto_tac (claset() addSEs [Return_changedE],
   30.46 +   "|- RPCFail send rcv rst p --> \
   30.47 +\      <RPCNext send rcv rst p>_(rst!p, rtrner send!p, caller rcv!p)"
   30.48 +   (fn _ => [auto_tac (claset() addSDs [Return_changed],
   30.49  		       simpset() addsimps [angle_def,RPCNext_def,RPCFail_def])
   30.50  	    ]);
   30.51  
   30.52  qed_goal "RPCFail_Next_enabled" RPC.thy
   30.53 -   "Enabled (RPCFail send rcv rst p) s \
   30.54 -\   ==> Enabled (<RPCNext send rcv rst p>_<rst@p, rtrner send @ p, caller rcv @ p>) s"
   30.55 -   (fn [prem] => [REPEAT (resolve_tac [prem RS enabled_mono,RPCFail_vis] 1)]);
   30.56 +   "|- Enabled (RPCFail send rcv rst p) --> \
   30.57 +\      Enabled (<RPCNext send rcv rst p>_(rst!p, rtrner send!p, caller rcv!p))"
   30.58 +   (fn _ => [force_tac (mem_css addSEs2 [enabled_mono,RPCFail_vis]) 1]);
   30.59  
   30.60  (* Enabledness of some actions *)
   30.61  
   30.62  qed_goal "RPCFail_enabled" RPC.thy
   30.63 -   "!!p. base_var <rtrner send @ p, caller rcv @ p, rst@p> ==> \
   30.64 -\        .~ $(Calling rcv p) .& $(Calling send p) .-> $(Enabled (RPCFail send rcv rst p))"
   30.65 +   "!!p. basevars (rtrner send!p, caller rcv!p, rst!p) ==> \
   30.66 +\        |- ~Calling rcv p & Calling send p --> Enabled (RPCFail send rcv rst p)"
   30.67     (fn _ => [action_simp_tac (simpset() addsimps [RPCFail_def,Return_def,caller_def,rtrner_def])
   30.68                               [] [base_enabled,Pair_inject] 1
   30.69  	    ]);
   30.70  
   30.71  qed_goal "RPCReply_enabled" RPC.thy
   30.72 -   "!!p. base_var <rtrner send @ p, caller rcv @ p, rst@p> ==> \
   30.73 -\        .~ $(Calling rcv p) .& $(Calling send p) .& $(rst@p) .= #rpcB \
   30.74 -\        .-> $(Enabled (RPCReply send rcv rst p))"
   30.75 +   "!!p. basevars (rtrner send!p, caller rcv!p, rst!p) ==> \
   30.76 +\        |- ~Calling rcv p & Calling send p & rst!p = #rpcB \
   30.77 +\           --> Enabled (RPCReply send rcv rst p)"
   30.78     (fn _ => [action_simp_tac (simpset() addsimps [RPCReply_def,Return_def,caller_def,rtrner_def])
   30.79                               [] [base_enabled,Pair_inject] 1]);
   30.80  
    31.1 --- a/src/HOL/TLA/Memory/RPC.thy	Mon Feb 08 13:02:42 1999 +0100
    31.2 +++ b/src/HOL/TLA/Memory/RPC.thy	Mon Feb 08 13:02:56 1999 +0100
    31.3 @@ -7,15 +7,13 @@
    31.4      Logic Image: TLA
    31.5  
    31.6      RPC-Memory example: RPC specification
    31.7 -    For simplicity, specify the instance of RPC that is used in the
    31.8 -    memory implementation (ignoring the BadCall exception).
    31.9  *)
   31.10  
   31.11 -RPC = RPCParameters + ProcedureInterface +
   31.12 +RPC = RPCParameters + ProcedureInterface + Memory +
   31.13  
   31.14  types
   31.15 -  rpcSndChType  = "(rpcArgType,Vals) channel"
   31.16 -  rpcRcvChType  = "(memArgType,Vals) channel"
   31.17 +  rpcSndChType  = "(rpcOp,Vals) channel"
   31.18 +  rpcRcvChType  = "memChType"
   31.19    rpcStType     = "(PrIds => rpcState) stfun"
   31.20  
   31.21  consts
   31.22 @@ -34,49 +32,47 @@
   31.23    RPCISpec   :: "rpcSndChType => rpcRcvChType => rpcStType => temporal"
   31.24  
   31.25  rules
   31.26 -  RPCInit_def       "$(RPCInit rcv rst p) .= 
   31.27 -                         ($(rst@p) .= # rpcA
   31.28 -                          .& .~ $(Calling rcv p))"
   31.29 +  RPCInit_def       "RPCInit rcv rst p == PRED ((rst!p = #rpcA) & ~Calling rcv p)"
   31.30  
   31.31 -  RPCFwd_def        "RPCFwd send rcv rst p ==
   31.32 +  RPCFwd_def        "RPCFwd send rcv rst p == ACT
   31.33                           $(Calling send p)
   31.34 -                         .& $(rst@p) .= # rpcA
   31.35 -                         .& IsLegalRcvArg[ arg[ $(send@p) ] ]
   31.36 -                         .& Call rcv p (RPCRelayArg[ arg[ $(send@p)] ])
   31.37 -                         .& (rst@p)$ .= # rpcB
   31.38 -                         .& unchanged (rtrner send @ p)"
   31.39 +                         & $(rst!p) = # rpcA
   31.40 +                         & IsLegalRcvArg<arg<$(send!p)>>
   31.41 +                         & Call rcv p RPCRelayArg<arg<send!p>>
   31.42 +                         & (rst!p)$ = # rpcB
   31.43 +                         & unchanged (rtrner send!p)"
   31.44  
   31.45 -  RPCReject_def     "RPCReject send rcv rst p ==
   31.46 -                         $(rst@p) .= # rpcA
   31.47 -                         .& .~ IsLegalRcvArg[ arg[ $(send@p) ] ]
   31.48 -                         .& Return send p (#BadCall)
   31.49 -                         .& unchanged <(rst@p), (caller rcv @ p)>"
   31.50 +  RPCReject_def     "RPCReject send rcv rst p == ACT
   31.51 +                           $(rst!p) = # rpcA
   31.52 +                         & ~IsLegalRcvArg<arg<$(send!p)>>
   31.53 +                         & Return send p #BadCall
   31.54 +                         & unchanged ((rst!p), (caller rcv!p))"
   31.55  
   31.56 -  RPCFail_def       "RPCFail send rcv rst p ==
   31.57 -                         .~ $(Calling rcv p)
   31.58 -                         .& Return send p (#RPCFailure)
   31.59 -                         .& (rst@p)$ .= #rpcA
   31.60 -                         .& unchanged (caller rcv @ p)"
   31.61 +  RPCFail_def       "RPCFail send rcv rst p == ACT
   31.62 +                           ~$(Calling rcv p)
   31.63 +                         & Return send p #RPCFailure
   31.64 +                         & (rst!p)$ = #rpcA
   31.65 +                         & unchanged (caller rcv!p)"
   31.66  
   31.67 -  RPCReply_def      "RPCReply send rcv rst p ==
   31.68 -                         .~ $(Calling rcv p)
   31.69 -                         .& $(rst@p) .= #rpcB
   31.70 -                         .& Return send p (res[$(rcv@p)])
   31.71 -                         .& (rst@p)$ .= #rpcA
   31.72 -                         .& unchanged (caller rcv @ p)"
   31.73 +  RPCReply_def      "RPCReply send rcv rst p == ACT
   31.74 +                           ~$(Calling rcv p)
   31.75 +                         & $(rst!p) = #rpcB
   31.76 +		         & Return send p res<rcv!p>
   31.77 +                         & (rst!p)$ = #rpcA
   31.78 +                         & unchanged (caller rcv!p)"
   31.79  
   31.80 -  RPCNext_def       "RPCNext send rcv rst p ==
   31.81 -                         RPCFwd send rcv rst p
   31.82 -                         .| RPCReject send rcv rst p
   31.83 -                         .| RPCFail send rcv rst p
   31.84 -                         .| RPCReply send rcv rst p"
   31.85 +  RPCNext_def       "RPCNext send rcv rst p == ACT
   31.86 +                        (  RPCFwd send rcv rst p
   31.87 +                         | RPCReject send rcv rst p
   31.88 +                         | RPCFail send rcv rst p
   31.89 +                         | RPCReply send rcv rst p)"
   31.90  
   31.91 -  RPCIPSpec_def     "RPCIPSpec send rcv rst p ==
   31.92 -                         Init($(RPCInit rcv rst p))
   31.93 -                         .& [][ RPCNext send rcv rst p ]_<rst@p, rtrner send @ p, caller rcv @ p>
   31.94 -                         .& WF(RPCNext send rcv rst p)_<rst@p, rtrner send @ p, caller rcv @ p>"
   31.95 +  RPCIPSpec_def     "RPCIPSpec send rcv rst p == TEMP
   31.96 +                           Init RPCInit rcv rst p
   31.97 +                         & [][ RPCNext send rcv rst p ]_(rst!p, rtrner send!p, caller rcv!p)
   31.98 +                         & WF(RPCNext send rcv rst p)_(rst!p, rtrner send!p, caller rcv!p)"
   31.99  
  31.100 -  RPCISpec_def      "RPCISpec send rcv rst == RALL p. RPCIPSpec send rcv rst p"
  31.101 +  RPCISpec_def      "RPCISpec send rcv rst == TEMP (! p. RPCIPSpec send rcv rst p)"
  31.102  
  31.103  end
  31.104  
    32.1 --- a/src/HOL/TLA/Memory/RPCMemoryParams.thy	Mon Feb 08 13:02:42 1999 +0100
    32.2 +++ b/src/HOL/TLA/Memory/RPCMemoryParams.thy	Mon Feb 08 13:02:56 1999 +0100
    32.3 @@ -12,9 +12,9 @@
    32.4  RPCMemoryParams = HOL +
    32.5  
    32.6  types
    32.7 -  bit = "bool"   (* signal wires for the procedure interface *)
    32.8 -                 (* Defined as bool for simplicity. All I should really need is *)
    32.9 -                 (* the existence of two distinct values. *)
   32.10 +  bit = "bool"   (* Signal wires for the procedure interface.
   32.11 +                    Defined as bool for simplicity. All I should really need is
   32.12 +                    the existence of two distinct values. *)
   32.13    Locs           (* "syntactic" value type *)
   32.14    Vals           (* "syntactic" value type *)
   32.15    PrIds          (* process id's *)
    33.1 --- a/src/HOL/TLA/Memory/RPCParameters.ML	Mon Feb 08 13:02:42 1999 +0100
    33.2 +++ b/src/HOL/TLA/Memory/RPCParameters.ML	Mon Feb 08 13:02:56 1999 +0100
    33.3 @@ -3,10 +3,15 @@
    33.4      Author:      Stephan Merz
    33.5      Copyright:   1997 University of Munich
    33.6  
    33.7 -    RPC-Memory example: RPC parameters (ML file)
    33.8 +    RPC-Memory example: RPC parameters (theorems and proofs)
    33.9  *)
   33.10  
   33.11  
   33.12 +(*
   33.13  val RP_simps = MP_simps @ [RFNoMemVal, NotAResultNotRF, OKNotRF, BANotRF]
   33.14                          @ (map (fn x => x RS not_sym) [NotAResultNotRF, OKNotRF, BANotRF])
   33.15 -                        @ rpcOps.simps @ rpcState.simps;
   33.16 +                        @ rpcState.simps @ rpcOp.simps;
   33.17 +*)
   33.18 +
   33.19 +Addsimps ([RFNoMemVal, NotAResultNotRF, OKNotRF, BANotRF]
   33.20 +          @ (map (fn x => x RS not_sym) [NotAResultNotRF, OKNotRF, BANotRF]));
    34.1 --- a/src/HOL/TLA/Memory/RPCParameters.thy	Mon Feb 08 13:02:42 1999 +0100
    34.2 +++ b/src/HOL/TLA/Memory/RPCParameters.thy	Mon Feb 08 13:02:56 1999 +0100
    34.3 @@ -13,9 +13,10 @@
    34.4  
    34.5  RPCParameters = MemoryParameters +
    34.6  
    34.7 -datatype  rpcOps = remoteCall
    34.8 +datatype  rpcOp = memcall memOp | othercall Vals
    34.9  datatype  rpcState = rpcA | rpcB
   34.10  
   34.11 +(***
   34.12  types
   34.13    (* type of RPC arguments other than memory calls *)
   34.14    noMemArgType
   34.15 @@ -24,31 +25,44 @@
   34.16  
   34.17  arities
   34.18    noMemArgType :: term
   34.19 +***)
   34.20  
   34.21  consts
   34.22    (* some particular return values *)
   34.23 -  RPCFailure     :: "Vals"
   34.24 -  BadCall        :: "Vals"
   34.25 +  RPCFailure     :: Vals
   34.26 +  BadCall        :: Vals
   34.27    
   34.28    (* Translate an rpc call to a memory call and test if the current argument
   34.29       is legal for the receiver (i.e., the memory). This can now be a little
   34.30       simpler than for the generic RPC component. RelayArg returns an arbitrary
   34.31       memory call for illegal arguments. *)
   34.32 -  IsLegalRcvArg  :: "rpcArgType => bool"
   34.33 -  RPCRelayArg    :: "rpcArgType => memArgType"
   34.34 +(***
   34.35 +  IsLegalRcvArg  :: rpcArgType => bool
   34.36 +  RPCRelayArg    :: rpcArgType => memArgType
   34.37 +***)
   34.38 +  IsLegalRcvArg  :: rpcOp => bool
   34.39 +  RPCRelayArg    :: rpcOp => memOp
   34.40  
   34.41  rules
   34.42    (* RPCFailure is different from MemVals and exceptions *)
   34.43 -  RFNoMemVal        "~(MemVal RPCFailure)"
   34.44 +  RFNoMemVal        "RPCFailure ~: MemVal"
   34.45    NotAResultNotRF   "NotAResult ~= RPCFailure"
   34.46    OKNotRF           "OK ~= RPCFailure"
   34.47    BANotRF           "BadArg ~= RPCFailure"
   34.48  
   34.49 +(***
   34.50    IsLegalRcvArg_def "IsLegalRcvArg ra == EX marg. ra = Inl (remoteCall,marg)"
   34.51    RPCRelayArg_def   "RPCRelayArg ra == 
   34.52                           case ra of Inl (rm) => (snd rm)
   34.53 -                                  | Inr (rn) => Inl (read, @ l. True)"
   34.54 -
   34.55 +                                  | Inr (rn) => (read, @ l. True)"
   34.56 +***)
   34.57 +defs
   34.58 +  IsLegalRcvArg_def "IsLegalRcvArg ra ==
   34.59 +		         case ra of (memcall m) => True
   34.60 +		                  | (othercall v) => False"
   34.61 +  RPCRelayArg_def   "RPCRelayArg ra ==
   34.62 +		         case ra of (memcall m) => m
   34.63 +		                  | (othercall v) => arbitrary"
   34.64  end
   34.65  
   34.66  
    35.1 --- a/src/HOL/TLA/README.html	Mon Feb 08 13:02:42 1999 +0100
    35.2 +++ b/src/HOL/TLA/README.html	Mon Feb 08 13:02:56 1999 +0100
    35.3 @@ -1,46 +1,59 @@
    35.4 -<HTML><HEAD><TITLE>HOL/TLA/README</TITLE></HEAD><BODY bgcolor="white">
    35.5 +<HTML><HEAD><TITLE>HOL/TLA</TITLE></HEAD><BODY>
    35.6  
    35.7 -<H3>TLA: A formalization of TLA in HOL</H3>
    35.8 -
    35.9 -Author:     Stephan Merz<BR>
   35.10 -Copyright   1997 Universit&auml;t M&uuml;nchen<P>
   35.11 +<H2>TLA: Lamport's Temporal Logic of Actions</H2>
   35.12  
   35.13 -The distribution contains a representation of Lamport's
   35.14 -<A HREF="http://www.research.digital.com/SRC/personal/Leslie_Lamport/tla/tla.html">
   35.15 -Temporal Logic of Actions</A>
   35.16 -in Isabelle/HOL.
   35.17 -
   35.18 -<p>
   35.19 +<A HREF="http://www.research.digital.com/SRC/personal/Leslie_Lamport/tla/tla.html">TLA</A>
   35.20 +is a linear-time temporal logic introduced by Leslie Lamport in
   35.21 +<EM>The Temporal Logic of Actions</EM> (ACM TOPLAS 16(3), 1994,
   35.22 +872-923). Unlike other temporal logics, both systems and properties
   35.23 +are represented as logical formulas, and logical connectives such as
   35.24 +implication, conjunction, and existential quantification represent
   35.25 +structural relations such as refinement, parallel composition, and
   35.26 +hiding. TLA has been applied to numerous case studies.
   35.27  
   35.28 -The encoding is mainly oriented towards practical verification
   35.29 -examples. It does not contain a formalization of TLA's semantics,
   35.30 -although it could be an interesting exercise to add such a formalization
   35.31 -to the existing representation. Instead, it is based on a 
   35.32 -<A HREF="http://www4.informatik.tu-muenchen.de/~merz/papers/ptla.ps">complete axiomatization</A>
   35.33 -of the "raw" (stuttering-sensitive) variant of propositional TLA. 
   35.34 -There is also a
   35.35 -<A HREF="http://www4.informatik.tu-muenchen.de/~merz/papers/IsaTLADesign.ps">design note</A> 
   35.36 -that explains the basic setup and use of the prover.
   35.37 -
   35.38 -<p>
   35.39 -
   35.40 -The distribution includes the following examples:
   35.41 +<P>This directory formalizes TLA in Isabelle/HOL, as follows:
   35.42  <UL>
   35.43 -  <li> a verification of Lamport's <em>increment</em> example
   35.44 -  (subdirectory inc),<P>
   35.45 -
   35.46 -  <li> a proof that two buffers in a row implement a single buffer
   35.47 -  (subdirectory buffer), and<P>
   35.48 -
   35.49 -   <li> the verification of Broy and Lamport's RPC-Memory example. For details see:<BR>
   35.50 -
   35.51 -        Mart&iacute;n Abadi, Leslie Lamport, and Stephan Merz: 
   35.52 -        <A HREF="http://www4.informatik.tu-muenchen.de/~merz/papers/RPCMemory.html">
   35.53 -        A TLA Solution to the RPC-Memory Specification Problem</A>.
   35.54 -        In: <i>Formal System Specification</i>, LNCS 1169, 1996, 21-69.
   35.55 +<LI>Theory <A HREF="Intensional.html">Intensional</A> prepares the
   35.56 +  ground by introducing basic syntax for "lifted", possibl-world based 
   35.57 +  logics.
   35.58 +<LI>Theories <A HREF="Stfun.html">Stfun</A> and
   35.59 +  <A HREF="Action.html">Action</A> represent the state and transition
   35.60 +  level formulas of TLA, evaluated over single states and pairs of
   35.61 +  states.
   35.62 +<LI>Theory <A HREF="Init.html">Init</A> introduces temporal logic
   35.63 +  and defines conversion functions from nontemporal to temporal
   35.64 +  formulas.
   35.65 +<LI>Theory <A HREF="TLA.html">TLA</A> axiomatizes proper temporal
   35.66 +  logic.
   35.67  </UL>
   35.68  
   35.69 -If you use Isabelle/TLA and have any comments, suggestions or contributions,
   35.70 -please contact <A HREF="mailto:merz@informatik.uni-muenchen.de">Stephan Merz</A>.
   35.71 +Please consult the
   35.72 +<A HREF="http://www4.in.tum.de/~merz/papers/IsaTLADesign.ps">design notes</A>
   35.73 +for further information regarding the setup and use of this encoding
   35.74 +of TLA.
   35.75  
   35.76 -</BODY></HTML>
   35.77 +<P>
   35.78 +The theories are accompanied by a small number of examples:
   35.79 +<UL>
   35.80 +<LI><A HREF="Inc/index.html">Inc</A>: Lamport's <EM>increment</EM>
   35.81 +  example, a standard TLA benchmark, illustrates an elementary TLA
   35.82 +  proof.
   35.83 +<LI><A HREF="Buffer/index.html">Buffer</A>: a proof that two buffers
   35.84 +  in a row implement a single buffer, uses a simple refinement
   35.85 +  mapping.
   35.86 +<LI><A HREF="Memory/index.html">Memory</A>: a verification of (the
   35.87 +  untimed part of) Broy and Lamport's <em>RPC-Memory</em> case study,
   35.88 +  more fully explained in LNCS 1169 (the 
   35.89 +  <A HREF="http://www4.in.tum.de/~merz/papers/RPCMemory.html">TLA
   35.90 +  solution</A> is available separately).
   35.91 +</UL>
   35.92 +
   35.93 +<HR>
   35.94 +
   35.95 +<ADDRESS>
   35.96 +<A HREF="merz@informatik.uni-muenchen.de">Stephan Merz</A>
   35.97 +</ADDRESS>
   35.98 +<!-- hhmts start -->
   35.99 +Last modified: Mon Jan 25 14:06:43 MET 1999
  35.100 +<!-- hhmts end -->
  35.101 +</BODY></HTML>
  35.102 \ No newline at end of file
    36.1 --- a/src/HOL/TLA/ROOT.ML	Mon Feb 08 13:02:42 1999 +0100
    36.2 +++ b/src/HOL/TLA/ROOT.ML	Mon Feb 08 13:02:56 1999 +0100
    36.3 @@ -5,23 +5,6 @@
    36.4  
    36.5  val banner = "Temporal Logic of Actions";
    36.6  
    36.7 -(*
    36.8 -   raise the ambiguity level to avoid ambiguity warnings;
    36.9 -   since Trueprop and TrueInt have both empty syntax, there is
   36.10 -   an unavoidable ambiguity in the TLA (actually, Intensional) grammar.
   36.11 -*)
   36.12 -Syntax.ambiguity_level := 10000;
   36.13 -
   36.14 -(*FIXME: the old auto_tac is sometimes needed!*)
   36.15 -fun old_auto_tac (cs,ss) = 
   36.16 -    let val cs' = cs addss ss 
   36.17 -    in  EVERY [TRY (safe_tac cs'),
   36.18 -               REPEAT (FIRSTGOAL (fast_tac cs')),
   36.19 -               TRY (safe_tac (cs addSss ss)),
   36.20 -               prune_params_tac] 
   36.21 -    end;
   36.22 -
   36.23 -
   36.24  use_thy "TLA";
   36.25  
   36.26  val TLA_build_completed = ();
    37.1 --- a/src/HOL/TLA/Stfun.ML	Mon Feb 08 13:02:42 1999 +0100
    37.2 +++ b/src/HOL/TLA/Stfun.ML	Mon Feb 08 13:02:56 1999 +0100
    37.3 @@ -1,25 +1,21 @@
    37.4  (* 
    37.5      File:	 Stfun.ML
    37.6      Author:      Stephan Merz
    37.7 -    Copyright:   1997 University of Munich
    37.8 +    Copyright:   1998 University of Munich
    37.9  
   37.10  Lemmas and tactics for states and state functions.
   37.11  *)
   37.12  
   37.13 -(* A stronger version of existential elimination (goal needn't be boolean) *)
   37.14 -qed_goalw "exE_prop" HOL.thy [Ex_def]
   37.15 -  "[| ? x::'a. P(x); !!x. P(x) ==> PROP R |] ==> PROP R"
   37.16 -  (fn prems => [REPEAT(resolve_tac prems 1)]);
   37.17 +(*  [| basevars v; !!x. v x = c ==> Q |] ==> Q  *)
   37.18 +bind_thm("baseE", (standard (basevars RS exE)));
   37.19  
   37.20 -(* Might as well use that version in automated proofs *)
   37.21 -AddSEs [exE_prop];
   37.22 +(* -------------------------------------------------------------------------------
   37.23 +   The following shows that there should not be duplicates in a "stvars" tuple:
   37.24  
   37.25 -(*  [| base_var v; !!x. v x = c ==> PROP R |] ==> PROP R  *)
   37.26 -bind_thm("baseE", (standard (base_var RS exE_prop)));
   37.27 +Goal "!!v. basevars (v::bool stfun, v) ==> False";
   37.28 +by (etac baseE 1);
   37.29 +by (subgoal_tac "(LIFT (v,v)) x = (True, False)" 1); 
   37.30 +by (atac 2);
   37.31 +by (Asm_full_simp_tac 1);
   37.32  
   37.33 -qed_goal "PairVarE" Stfun.thy
   37.34 -  "[| <v,w> u = (x,y); [| v u = x; w u = y |] ==> PROP R |] ==> PROP R"
   37.35 -  (fn prems => [cut_facts_tac prems 1, resolve_tac prems 1,
   37.36 -		ALLGOALS (asm_full_simp_tac (simpset() addsimps [pairSF_def]))
   37.37 -               ]);
   37.38 -
   37.39 +------------------------------------------------------------------------------- *)
    38.1 --- a/src/HOL/TLA/Stfun.thy	Mon Feb 08 13:02:42 1999 +0100
    38.2 +++ b/src/HOL/TLA/Stfun.thy	Mon Feb 08 13:02:56 1999 +0100
    38.3 @@ -1,15 +1,15 @@
    38.4  (* 
    38.5      File:	 TLA/Stfun.thy
    38.6      Author:      Stephan Merz
    38.7 -    Copyright:   1997 University of Munich
    38.8 +    Copyright:   1998 University of Munich
    38.9  
   38.10      Theory Name: Stfun
   38.11      Logic Image: HOL
   38.12  
   38.13 -States and state functions for TLA
   38.14 +States and state functions for TLA as an "intensional" logic.
   38.15  *)
   38.16  
   38.17 -Stfun  =  Prod +
   38.18 +Stfun  =  Intensional +
   38.19  
   38.20  types
   38.21      state
   38.22 @@ -17,40 +17,49 @@
   38.23      stpred   = "bool stfun"
   38.24  
   38.25  arities
   38.26 -    state :: term
   38.27 +  state :: term
   38.28 +
   38.29 +instance
   38.30 +  state :: world
   38.31  
   38.32  consts
   38.33 -  (* For simplicity, we do not syntactically distinguish between state variables
   38.34 -     and state functions, and treat "state" as an anonymous type. But we need a 
   38.35 -     "meta-predicate" to identify "base" state variables that represent the state
   38.36 -     components of a system, in particular to define the enabledness of actions.
   38.37 +  (* Formalizing type "state" would require formulas to be tagged with
   38.38 +     their underlying state space and would result in a system that is
   38.39 +     much harder to use. (Unlike Hoare logic or Unity, TLA has quantification
   38.40 +     over state variables, and therefore one usually works with different
   38.41 +     state spaces within a single specification.) Instead, "state" is just
   38.42 +     an anonymous type whose only purpose is to provide "Skolem" constants.
   38.43 +     Moreover, we do not define a type of state variables separate from that
   38.44 +     of arbitrary state functions, again in order to simplify the definition
   38.45 +     of flexible quantification later on. Nevertheless, we need to distinguish
   38.46 +     state variables, mainly to define the enabledness of actions. The user
   38.47 +     identifies (tuples of) "base" state variables in a specification via the
   38.48 +     "meta predicate" stvars.
   38.49 +     NOTE: There should not be duplicates in the tuple!
   38.50    *)
   38.51 -  base_var  :: "'a stfun => bool"
   38.52 -
   38.53 -  (* lift tupling to state functions *)
   38.54 -  pairSF    :: "['a stfun, 'b stfun] => ('a * 'b) stfun"
   38.55 +  stvars    :: "'a stfun => bool"
   38.56  
   38.57  syntax
   38.58 -  "@tupleSF"     :: "args => ('a * 'b) stfun"  ("(1<_>)")
   38.59 +  "PRED"    :: lift => 'a                          ("PRED _")
   38.60 +  "_stvars" :: lift => bool                        ("basevars _")
   38.61  
   38.62  translations
   38.63 -  "<x,y,z>"   == "<x, <y,z> >"
   38.64 -  "<x,y>"     == "pairSF x y"
   38.65 -  "<x>"       => "x"
   38.66 +  "PRED P"   =>  "(P::state => _)"
   38.67 +  "_stvars"  ==  "stvars"
   38.68  
   38.69  rules
   38.70 -  (* tupling *)
   38.71 -  pairSF_def  "<v,w>(s) = (v(s),w(s))"
   38.72 +  (* Base variables may be assigned arbitrary (type-correct) values. 
   38.73 +     Note that vs may be a tuple of variables. The rule would be unsound 
   38.74 +     if vs contained duplicates.
   38.75 +  *)
   38.76 +  basevars  "basevars vs ==> EX u. vs u = c"
   38.77 +  base_pair "basevars (x,y) ==> basevars x & basevars y"
   38.78 +  (* Since the unit type has just one value, any state function can be
   38.79 +     regarded as "base". The following axiom can sometimes be useful
   38.80 +     because it gives a trivial solution for "basevars" premises.
   38.81 +  *)
   38.82 +  unit_base "basevars (v::unit stfun)"
   38.83  
   38.84 -  (* "base" variables may be assigned arbitrary values by states.
   38.85 -     NB: It's really stronger than that because "u" doesn't depend 
   38.86 -         on either c or v. In particular, if "==>" were replaced
   38.87 -         with "==", base_pair would (still) not be derivable.
   38.88 -  *)
   38.89 -  base_var    "base_var v ==> EX u. v u = c"
   38.90 -
   38.91 -  (* a tuple of variables is "base" if each variable is "base" *)
   38.92 -  base_pair   "base_var <v,w> = (base_var v & base_var w)"
   38.93  end
   38.94  
   38.95  ML
    39.1 --- a/src/HOL/TLA/TLA.ML	Mon Feb 08 13:02:42 1999 +0100
    39.2 +++ b/src/HOL/TLA/TLA.ML	Mon Feb 08 13:02:56 1999 +0100
    39.3 @@ -1,94 +1,72 @@
    39.4  (* 
    39.5      File:	 TLA/TLA.ML
    39.6      Author:      Stephan Merz
    39.7 -    Copyright:   1997 University of Munich
    39.8 +    Copyright:   1998 University of Munich
    39.9  
   39.10  Lemmas and tactics for temporal reasoning.
   39.11  *)
   39.12  
   39.13 -(* Specialize intensional introduction/elimination rules to temporal formulas *)
   39.14 +(* Specialize intensional introduction/elimination rules for temporal formulas *)
   39.15  
   39.16 -qed_goal "tempI" TLA.thy "(!!sigma. (sigma |= (F::temporal))) ==> F"
   39.17 +qed_goal "tempI" TLA.thy "(!!sigma. sigma |= (F::temporal)) ==> |- F"
   39.18    (fn [prem] => [ REPEAT (resolve_tac [prem,intI] 1) ]);
   39.19  
   39.20 -qed_goal "tempD" TLA.thy "F::temporal ==> (sigma |= F)"
   39.21 -  (fn [prem] => [ REPEAT (resolve_tac [prem,intD] 1) ]);
   39.22 +qed_goal "tempD" TLA.thy "|- (F::temporal) ==> sigma |= F"
   39.23 +  (fn [prem] => [ rtac (prem RS intD) 1 ]);
   39.24  
   39.25  
   39.26 -(* ======== Functions to "unlift" temporal implications into HOL rules ====== *)
   39.27 -
   39.28 -(* Basic unlifting introduces a parameter "sigma" and applies basic rewrites, e.g.
   39.29 -   F .= G    gets   (sigma |= F) = (sigma |= G)
   39.30 -   F .-> G   gets   (sigma |= F) --> (sigma |= G)
   39.31 -*)
   39.32 -fun temp_unlift th = rewrite_rule intensional_rews (th RS tempD);
   39.33 -
   39.34 -(* F .-> G   becomes   sigma |= F  ==>  sigma |= G *)
   39.35 -fun temp_mp th = zero_var_indexes ((temp_unlift th) RS mp);
   39.36 +(* ======== Functions to "unlift" temporal theorems ====== *)
   39.37  
   39.38 -(* F .-> G   becomes   [| sigma |= F; sigma |= G ==> R |] ==> R 
   39.39 -   so that it can be used as an elimination rule
   39.40 +(* The following functions are specialized versions of the corresponding
   39.41 +   functions defined in Intensional.ML in that they introduce a
   39.42 +   "world" parameter of type "behavior".
   39.43  *)
   39.44 -fun temp_impE th = zero_var_indexes ((temp_unlift th) RS impE);
   39.45 +fun temp_unlift th = 
   39.46 +    (rewrite_rule action_rews (th RS tempD))
   39.47 +    handle _ => action_unlift th;
   39.48  
   39.49 -(* F .& G .-> H  becomes  [| sigma |= F; sigma |= G |] ==> sigma |= H *)
   39.50 -fun temp_conjmp th = zero_var_indexes (conjI RS (temp_mp th));
   39.51 +(* Turn  |- F = G  into meta-level rewrite rule  F == G *)
   39.52 +val temp_rewrite = int_rewrite;
   39.53  
   39.54 -(* F .& G .-> H  becomes  [| sigma |= F; sigma |= G; (sigma |= H ==> R) |] ==> R *)
   39.55 -fun temp_conjimpE th = zero_var_indexes (conjI RS (temp_impE th));
   39.56 -
   39.57 -(* Turn  F .= G  into meta-level rewrite rule  F == G *)
   39.58 -fun temp_rewrite th = (rewrite_rule intensional_rews (th RS inteq_reflection));
   39.59 -
   39.60 +fun temp_use th = 
   39.61 +    case (concl_of th) of
   39.62 +      Const _ $ (Const ("Intensional.Valid", _) $ _) =>
   39.63 +              ((flatten (temp_unlift th)) handle _ => th)
   39.64 +    | _ => th;
   39.65  
   39.66  (* Update classical reasoner---will be updated once more below! *)
   39.67  
   39.68  AddSIs [tempI];
   39.69  AddDs [tempD];
   39.70  
   39.71 -val temp_css = action_css addSIs2 [tempI] addDs2 [tempD];
   39.72 +val temp_css = (claset(), simpset());
   39.73  val temp_cs = op addss temp_css;
   39.74  
   39.75 -(* ========================================================================= *)
   39.76 -section "Init";
   39.77 -
   39.78 -(* Push logical connectives through Init. *)
   39.79 -qed_goal "Init_true" TLA.thy "Init(#True) .= #True"
   39.80 -  (fn _ => [ auto_tac (temp_css addsimps2 [Init_def]) ]);
   39.81 +(* Modify the functions that add rules to simpsets, classical sets,
   39.82 +   and clasimpsets in order to accept "lifted" theorems
   39.83 +*)
   39.84  
   39.85 -qed_goal "Init_false" TLA.thy "Init(#False) .= #False"
   39.86 -  (fn _ => [ auto_tac (temp_css addsimps2 [Init_def]) ]);
   39.87 -
   39.88 -qed_goal "Init_not" TLA.thy "Init(.~P) .= (.~Init(P))"
   39.89 -  (fn _ => [ auto_tac (temp_css addsimps2 [Init_def]) ]);
   39.90 -
   39.91 -qed_goal "Init_and" TLA.thy "Init(P .& Q) .= (Init(P) .& Init(Q))"
   39.92 -  (fn _ => [ auto_tac (temp_css addsimps2 [Init_def]) ]);
   39.93 -
   39.94 -qed_goal "Init_or" TLA.thy "Init(P .| Q) .= (Init(P) .| Init(Q))"
   39.95 -  (fn _ => [ auto_tac (temp_css addsimps2 [Init_def]) ]);
   39.96 +local
   39.97 +  fun try_rewrite th =
   39.98 +      (temp_rewrite th) handle _ => temp_use th
   39.99 +in
  39.100 +  val op addsimps = fn (ss, ts) => ss addsimps (map try_rewrite ts)
  39.101 +  val op addsimps2 = fn (css, ts) => css addsimps2 (map try_rewrite ts)
  39.102 +end;
  39.103  
  39.104 -qed_goal "Init_imp" TLA.thy "Init(P .-> Q) .= (Init(P) .-> Init(Q))"
  39.105 -  (fn _ => [ auto_tac (temp_css addsimps2 [Init_def]) ]);
  39.106 -
  39.107 -qed_goal "Init_iff" TLA.thy "Init(P .= Q) .= (Init(P) .= Init(Q))"
  39.108 -  (fn _ => [ auto_tac (temp_css addsimps2 [Init_def]) ]);
  39.109 -
  39.110 -qed_goal "Init_all" TLA.thy "Init(RALL x. P(x)) .= (RALL x. Init(P(x)))"
  39.111 -  (fn _ => [ auto_tac (temp_css addsimps2 [Init_def]) ]);
  39.112 +val op addSIs = fn (cs, ts) => cs addSIs (map temp_use ts);
  39.113 +val op addSEs = fn (cs, ts) => cs addSEs (map temp_use ts);
  39.114 +val op addSDs = fn (cs, ts) => cs addSDs (map temp_use ts);
  39.115 +val op addIs = fn (cs, ts) => cs addIs (map temp_use ts);
  39.116 +val op addEs = fn (cs, ts) => cs addEs (map temp_use ts);
  39.117 +val op addDs = fn (cs, ts) => cs addDs (map temp_use ts);
  39.118  
  39.119 -qed_goal "Init_ex" TLA.thy "Init(REX x. P(x)) .= (REX x. Init(P(x)))"
  39.120 -  (fn _ => [ auto_tac (temp_css addsimps2 [Init_def]) ]);
  39.121 -
  39.122 -val Init_simps = map temp_rewrite
  39.123 -                     [Init_true,Init_false,Init_not,Init_and,Init_or,
  39.124 -		      Init_imp,Init_iff,Init_all,Init_ex];
  39.125 -
  39.126 -
  39.127 -(* Temporal lemmas *)
  39.128 -
  39.129 -qed_goalw "DmdAct" TLA.thy [dmd_def,boxact_def] "(<>(F::action)) .= (<> Init F)"
  39.130 -  (fn _ => [auto_tac (temp_css addsimps2 Init_simps)]);
  39.131 +val op addSIs2 = fn (css, ts) => css addSIs2 (map temp_use ts);
  39.132 +val op addSEs2 = fn (css, ts) => css addSEs2 (map temp_use ts);
  39.133 +val op addSDs2 = fn (css, ts) => css addSDs2 (map temp_use ts);
  39.134 +val op addIs2 = fn (css, ts) => css addIs2 (map temp_use ts);
  39.135 +val op addEs2 = fn (css, ts) => css addEs2 (map temp_use ts);
  39.136 +val op addDs2 = fn (css, ts) => css addDs2 (map temp_use ts);
  39.137  
  39.138  
  39.139  (* ------------------------------------------------------------------------- *)
  39.140 @@ -96,29 +74,55 @@
  39.141  (* ------------------------------------------------------------------------- *)
  39.142  section "Simple temporal logic";
  39.143  
  39.144 +(* []~F == []~Init F *)
  39.145 +bind_thm("boxNotInit", rewrite_rule Init_simps (read_instantiate [("F", "LIFT ~F")] boxInit));
  39.146 +
  39.147 +qed_goalw "dmdInit" TLA.thy [dmd_def] "TEMP <>F == TEMP <> Init F"
  39.148 +  (fn _ => [rewtac (read_instantiate [("F", "LIFT ~F")] boxInit),
  39.149 +            simp_tac (simpset() addsimps Init_simps) 1]);
  39.150 +
  39.151 +bind_thm("dmdNotInit", rewrite_rule Init_simps (read_instantiate [("F", "LIFT ~F")] dmdInit));
  39.152 +
  39.153 +(* boxInit and dmdInit cannot be used as rewrites, because they loop.
  39.154 +   Non-looping instances for state predicates and actions are occasionally useful.
  39.155 +*)
  39.156 +bind_thm("boxInit_stp", read_instantiate [("'a","state")] boxInit);
  39.157 +bind_thm("boxInit_act", read_instantiate [("'a","state * state")] boxInit);
  39.158 +bind_thm("dmdInit_stp", read_instantiate [("'a","state")] dmdInit);
  39.159 +bind_thm("dmdInit_act", read_instantiate [("'a","state * state")] dmdInit);
  39.160 +
  39.161 +(* The symmetric equations can be used to get rid of Init *)
  39.162 +bind_thm("boxInitD", symmetric boxInit);
  39.163 +bind_thm("dmdInitD", symmetric dmdInit);
  39.164 +bind_thm("boxNotInitD", symmetric boxNotInit);
  39.165 +bind_thm("dmdNotInitD", symmetric dmdNotInit);
  39.166 +
  39.167 +val Init_simps = Init_simps @ [boxInitD, dmdInitD, boxNotInitD, dmdNotInitD];
  39.168 +
  39.169  (* ------------------------ STL2 ------------------------------------------- *)
  39.170  bind_thm("STL2", reflT);
  39.171 -bind_thm("STL2D", temp_mp STL2);
  39.172  
  39.173 -(* The action variants. *)
  39.174 -qed_goalw "STL2b" TLA.thy [boxact_def] "[]P .-> Init P"
  39.175 -   (fn _ => [rtac STL2 1]);
  39.176 -bind_thm("STL2bD", temp_mp STL2b);
  39.177 -(* see also STL2b_pr below: "[]P .-> Init(P .& P`)" *)
  39.178 +(* The "polymorphic" (generic) variant *)
  39.179 +qed_goal "STL2_gen" TLA.thy "|- []F --> Init F"
  39.180 +  (fn _ => [rewtac (read_instantiate [("F", "F")] boxInit),
  39.181 +            rtac STL2 1]);
  39.182 +
  39.183 +(* see also STL2_pr below: "|- []P --> Init P & Init (P`)" *)
  39.184 +
  39.185  
  39.186  (* Dual versions for <> *)
  39.187 -qed_goalw "ImplDmd" TLA.thy [dmd_def] "F .-> <>F"
  39.188 -   (fn _ => [ auto_tac (temp_css addSDs2 [STL2D]) ]);
  39.189 -bind_thm ("ImplDmdD", temp_mp ImplDmd);
  39.190 +qed_goalw "InitDmd" TLA.thy [dmd_def] "|- F --> <> F"
  39.191 +   (fn _ => [ auto_tac (temp_css addSDs2 [STL2]) ]);
  39.192  
  39.193 -qed_goalw "InitDmd" TLA.thy [dmd_def] "Init(P) .-> <>P"
  39.194 -   (fn _ => [ auto_tac (temp_css addsimps2 Init_simps addSDs2 [STL2bD]) ]);
  39.195 -bind_thm("InitDmdD", temp_mp InitDmd);
  39.196 +qed_goal "InitDmd_gen" TLA.thy "|- Init F --> <>F"
  39.197 +   (fn _ => [Clarsimp_tac 1,
  39.198 +             dtac (temp_use InitDmd) 1,
  39.199 +             asm_full_simp_tac (simpset() addsimps [dmdInitD]) 1]);
  39.200  
  39.201  
  39.202  (* ------------------------ STL3 ------------------------------------------- *)
  39.203 -qed_goal "STL3" TLA.thy "([][]F) .= ([]F)"
  39.204 -   (K [force_tac (temp_css addIs2 [temp_mp transT,temp_mp STL2]) 1]);
  39.205 +qed_goal "STL3" TLA.thy "|- ([][]F) = ([]F)"
  39.206 +   (K [force_tac (temp_css addEs2 [transT,STL2]) 1]);
  39.207  
  39.208  (* corresponding elimination rule introduces double boxes: 
  39.209     [| (sigma |= []F); (sigma |= [][]F) ==> PROP W |] ==> PROP W
  39.210 @@ -127,23 +131,31 @@
  39.211  bind_thm("dup_boxD", (temp_unlift STL3) RS iffD1);
  39.212  
  39.213  (* dual versions for <> *)
  39.214 -qed_goalw "DmdDmd" TLA.thy [dmd_def] "(<><>F) .= (<>F)"
  39.215 +qed_goalw "DmdDmd" TLA.thy [dmd_def] "|- (<><>F) = (<>F)"
  39.216     (fn _ => [ auto_tac (temp_css addsimps2 [STL3]) ]);
  39.217  bind_thm("dup_dmdE", make_elim((temp_unlift DmdDmd) RS iffD2));
  39.218  bind_thm("dup_dmdD", (temp_unlift DmdDmd) RS iffD1);
  39.219  
  39.220  
  39.221  (* ------------------------ STL4 ------------------------------------------- *)
  39.222 -qed_goal "STL4" TLA.thy "(F .-> G)  ==> ([]F .-> []G)"
  39.223 -   (fn [prem] => [Auto_tac,
  39.224 -		  rtac ((temp_mp normalT) RS mp) 1,
  39.225 -		  REPEAT (ares_tac [prem, necT RS tempD] 1)
  39.226 +qed_goal "STL4" TLA.thy "|- F --> G  ==> |- []F --> []G"
  39.227 +   (fn [prem] => [Clarsimp_tac 1,
  39.228 +		  rtac (temp_use normalT) 1,
  39.229 +                  rtac (temp_use (prem RS necT)) 1,
  39.230 +		  atac 1
  39.231  		 ]);
  39.232  
  39.233 -(* A more practical variant as an (unlifted) elimination rule *)
  39.234 +(* Unlifted version as an elimination rule *)
  39.235  qed_goal "STL4E" TLA.thy 
  39.236 -         "[| (sigma |= []F); F .-> G |] ==> (sigma |= []G)"
  39.237 -   (fn prems => [ REPEAT (resolve_tac (prems @ [temp_mp STL4]) 1) ]);
  39.238 +         "[| sigma |= []F; |- F --> G |] ==> sigma |= []G"
  39.239 +   (fn prems => [ REPEAT (resolve_tac (prems @ [temp_use STL4]) 1) ]);
  39.240 +
  39.241 +qed_goal "STL4_gen" TLA.thy "|- Init F --> Init G ==> |- []F --> []G"
  39.242 +   (fn [prem] => [rtac (rewrite_rule [boxInitD] (prem RS STL4)) 1]);
  39.243 +
  39.244 +qed_goal "STL4E_gen" TLA.thy
  39.245 +         "[| sigma |= []F; |- Init F --> Init G |] ==> sigma |= []G"
  39.246 +   (fn prems => [ REPEAT (resolve_tac (prems @ [temp_use STL4_gen]) 1) ]);
  39.247  
  39.248  (* see also STL4Edup below, which allows an auxiliary boxed formula:
  39.249         []A /\ F => G
  39.250 @@ -153,19 +165,19 @@
  39.251  
  39.252  (* The dual versions for <> *)
  39.253  qed_goalw "DmdImpl" TLA.thy [dmd_def]
  39.254 -   "(F .-> G) ==> (<>F .-> <>G)"
  39.255 -   (fn [prem] => [fast_tac (temp_cs addSIs [int_mp prem] addSEs [STL4E]) 1]);
  39.256 +   "|- F --> G ==> |- <>F --> <>G"
  39.257 +   (fn [prem] => [fast_tac (temp_cs addSIs [prem] addSEs [STL4E]) 1]);
  39.258  
  39.259  qed_goal "DmdImplE" TLA.thy
  39.260 -   "[| (sigma |= <>F); F .-> G |] ==> (sigma |= <>G)"
  39.261 -   (fn prems => [ REPEAT (resolve_tac (prems @ [temp_mp DmdImpl]) 1) ]);
  39.262 +   "[| sigma |= <>F; |- F --> G |] ==> sigma |= <>G"
  39.263 +   (fn prems => [ REPEAT (resolve_tac (prems @ [temp_use DmdImpl]) 1) ]);
  39.264  
  39.265  
  39.266  (* ------------------------ STL5 ------------------------------------------- *)
  39.267 -qed_goal "STL5" TLA.thy "([]F .& []G) .= ([](F .& G))"
  39.268 +qed_goal "STL5" TLA.thy "|- ([]F & []G) = ([](F & G))"
  39.269     (fn _ => [Auto_tac,
  39.270 -	     subgoal_tac "sigma |= [](G .-> (F .& G))" 1,
  39.271 -	     etac ((temp_mp normalT) RS mp) 1, atac 1,
  39.272 +	     subgoal_tac "sigma |= [](G --> (F & G))" 1,
  39.273 +	     etac (temp_use normalT) 1, atac 1,
  39.274  	     ALLGOALS (fast_tac (temp_cs addSEs [STL4E]))
  39.275  	    ]);
  39.276  (* rewrite rule to split conjunctions under boxes *)
  39.277 @@ -173,63 +185,65 @@
  39.278  
  39.279  (* the corresponding elimination rule allows to combine boxes in the hypotheses
  39.280     (NB: F and G must have the same type, i.e., both actions or temporals.)
  39.281 +   Use "addSE2" etc. if you want to add this to a claset, otherwise it will loop!
  39.282  *)
  39.283  qed_goal "box_conjE" TLA.thy
  39.284 -   "[| (sigma |= []F); (sigma |= []G); (sigma |= [](F.&G)) ==> PROP R |] ==> PROP R"
  39.285 +   "[| sigma |= []F; sigma |= []G; sigma |= [](F&G) ==> PROP R |] ==> PROP R"
  39.286     (fn prems => [ REPEAT (resolve_tac
  39.287  			   (prems @ [(temp_unlift STL5) RS iffD1, conjI]) 1) ]);
  39.288  
  39.289 +(* Instances of box_conjE for state predicates, actions, and temporals
  39.290 +   in case the general rule is "too polymorphic".
  39.291 +*)
  39.292 +bind_thm("box_conjE_temp", read_instantiate [("'a","behavior")] box_conjE);
  39.293 +bind_thm("box_conjE_stp", read_instantiate [("'a","state")] box_conjE);
  39.294 +bind_thm("box_conjE_act", read_instantiate [("'a","state * state")] box_conjE);
  39.295 +
  39.296  (* Define a tactic that tries to merge all boxes in an antecedent. The definition is
  39.297 -   a bit kludgy: how do you simulate "double elim-resolution"?
  39.298 -   Note: If there are boxed hypotheses of different types, the tactic may delete the 
  39.299 -         wrong formulas. We therefore also define less polymorphic tactics for
  39.300 -         temporals and actions.
  39.301 +   a bit kludgy in order to simulate "double elim-resolution".
  39.302  *)
  39.303 -qed_goal "box_thin" TLA.thy "[| (sigma |= []F); PROP W |] ==> PROP W"
  39.304 -  (fn prems => [resolve_tac prems 1]);
  39.305 +
  39.306 +Goal "[| sigma |= []F; PROP W |] ==> PROP W";
  39.307 +by (atac 1);
  39.308 +val box_thin = result();
  39.309  
  39.310  fun merge_box_tac i =
  39.311     REPEAT_DETERM (EVERY [etac box_conjE i, atac i, etac box_thin i]);
  39.312  
  39.313 -qed_goal "temp_box_conjE" TLA.thy
  39.314 -   "[| (sigma |= [](F::temporal)); (sigma |= []G); (sigma |= [](F.&G)) ==> PROP R |] ==> PROP R"
  39.315 -   (fn prems => [ REPEAT (resolve_tac
  39.316 -			   (prems @ [(temp_unlift STL5) RS iffD1, conjI]) 1) ]);
  39.317 -qed_goal "temp_box_thin" TLA.thy "[| (sigma |= [](F::temporal)); PROP W |] ==> PROP W"
  39.318 -  (fn prems => [resolve_tac prems 1]);
  39.319  fun merge_temp_box_tac i =
  39.320 -   REPEAT_DETERM (EVERY [etac temp_box_conjE i, atac i, etac temp_box_thin i]);
  39.321 +   REPEAT_DETERM (EVERY [etac box_conjE_temp i, atac i, 
  39.322 +                         eres_inst_tac [("'a","behavior")] box_thin i]);
  39.323  
  39.324 -qed_goal "act_box_conjE" TLA.thy
  39.325 -   "[| (sigma |= [](A::action)); (sigma |= []B); (sigma |= [](A.&B)) ==> PROP R |] ==> PROP R"
  39.326 -   (fn prems => [ REPEAT (resolve_tac
  39.327 -			   (prems @ [(temp_unlift STL5) RS iffD1, conjI]) 1) ]);
  39.328 -qed_goal "act_box_thin" TLA.thy "[| (sigma |= [](A::action)); PROP W |] ==> PROP W"
  39.329 -  (fn prems => [resolve_tac prems 1]);
  39.330 +fun merge_stp_box_tac i =
  39.331 +   REPEAT_DETERM (EVERY [etac box_conjE_stp i, atac i, 
  39.332 +                         eres_inst_tac [("'a","state")] box_thin i]);
  39.333 +
  39.334  fun merge_act_box_tac i =
  39.335 -   REPEAT_DETERM (EVERY [etac act_box_conjE i, atac i, etac act_box_thin i]);
  39.336 +   REPEAT_DETERM (EVERY [etac box_conjE_act i, atac i, 
  39.337 +                         eres_inst_tac [("'a","state * state")] box_thin i]);
  39.338 +
  39.339  
  39.340  (* rewrite rule to push universal quantification through box:
  39.341 -      (sigma |= [](RALL x. F x)) = (! x. (sigma |= []F x))
  39.342 +      (sigma |= [](! x. F x)) = (! x. (sigma |= []F x))
  39.343  *)
  39.344  bind_thm("all_box", standard((temp_unlift allT) RS sym));
  39.345  
  39.346  
  39.347 -qed_goal "DmdOr" TLA.thy "(<>(F .| G)) .= (<>F .| <>G)"
  39.348 +qed_goal "DmdOr" TLA.thy "|- (<>(F | G)) = (<>F | <>G)"
  39.349     (fn _ => [auto_tac (temp_css addsimps2 [dmd_def,split_box_conj]),
  39.350               TRYALL (EVERY' [etac swap, 
  39.351                               merge_box_tac, 
  39.352                               fast_tac (temp_cs addSEs [STL4E])])
  39.353              ]);
  39.354  
  39.355 -qed_goal "exT" TLA.thy "(REX x. <>(F x)) .= (<>(REX x. F x))"
  39.356 -   (fn _ => [ auto_tac (temp_css addsimps2 [dmd_def,temp_rewrite Not_rex,all_box]) ]);
  39.357 +qed_goal "exT" TLA.thy "|- (? x. <>(F x)) = (<>(? x. F x))"
  39.358 +   (fn _ => [ auto_tac (temp_css addsimps2 [dmd_def,Not_Rex,all_box]) ]);
  39.359  
  39.360  bind_thm("ex_dmd", standard((temp_unlift exT) RS sym));
  39.361  	     
  39.362  
  39.363  qed_goal "STL4Edup" TLA.thy
  39.364 -   "!!sigma. [| (sigma |= []A); (sigma |= []F); F .& []A .-> G |] ==> (sigma |= []G)"
  39.365 +   "!!sigma. [| sigma |= []A; sigma |= []F; |- F & []A --> G |] ==> sigma |= []G"
  39.366     (fn _ => [etac dup_boxE 1,
  39.367  	     merge_box_tac 1,
  39.368  	     etac STL4E 1,
  39.369 @@ -237,7 +251,7 @@
  39.370  	    ]);
  39.371  
  39.372  qed_goalw "DmdImpl2" TLA.thy [dmd_def]
  39.373 -   "!!sigma. [| (sigma |= <>F); (sigma |= [](F .-> G)) |] ==> (sigma |= <>G)"
  39.374 +   "!!sigma. [| sigma |= <>F; sigma |= [](F --> G) |] ==> sigma |= <>G"
  39.375     (fn _ => [Auto_tac,
  39.376  	     etac notE 1,
  39.377  	     merge_box_tac 1,
  39.378 @@ -245,41 +259,51 @@
  39.379  	    ]);
  39.380  
  39.381  qed_goal "InfImpl" TLA.thy
  39.382 -   "[| (sigma |= []<>F); (sigma |= []G); F .& G .-> H |] ==> (sigma |= []<>H)"
  39.383 +   "[| sigma |= []<>F; sigma |= []G; |- F & G --> H |] ==> sigma |= []<>H"
  39.384     (fn [prem1,prem2,prem3] 
  39.385         => [cut_facts_tac [prem1,prem2] 1,
  39.386  	   eres_inst_tac [("F","G")] dup_boxE 1,
  39.387  	   merge_box_tac 1,
  39.388 -	   fast_tac (temp_cs addSEs [STL4E,DmdImpl2] addSIs [int_mp prem3]) 1
  39.389 +	   fast_tac (temp_cs addSEs [STL4E,DmdImpl2] addSIs [prem3]) 1
  39.390  	  ]);
  39.391  
  39.392  (* ------------------------ STL6 ------------------------------------------- *)
  39.393  (* Used in the proof of STL6, but useful in itself. *)
  39.394 -qed_goalw "BoxDmdT" TLA.thy [dmd_def] "[]F .& <>G .-> <>([]F .& G)"
  39.395 -  (fn _ => [ Auto_tac,
  39.396 +qed_goalw "BoxDmd" TLA.thy [dmd_def] "|- []F & <>G --> <>([]F & G)"
  39.397 +  (fn _ => [ Clarsimp_tac 1,
  39.398               etac dup_boxE 1,
  39.399  	     merge_box_tac 1,
  39.400               etac swap 1,
  39.401               fast_tac (temp_cs addSEs [STL4E]) 1 ]);
  39.402 -bind_thm("BoxDmd", temp_conjmp BoxDmdT);
  39.403  
  39.404  (* weaker than BoxDmd, but more polymorphic (and often just right) *)
  39.405 -qed_goalw "BoxDmdT2" TLA.thy [dmd_def] "<>F .& []G .-> <>(F .& G)"
  39.406 -  (fn _ => [ Auto_tac,
  39.407 +qed_goalw "BoxDmd_simple" TLA.thy [dmd_def] "|- []F & <>G --> <>(F & G)"
  39.408 +  (fn _ => [ Clarsimp_tac 1,
  39.409 +	     merge_box_tac 1,
  39.410 +             fast_tac (temp_cs addSEs [notE,STL4E]) 1
  39.411 +	   ]);
  39.412 +
  39.413 +qed_goalw "BoxDmd2_simple" TLA.thy [dmd_def] "|- []F & <>G --> <>(G & F)"
  39.414 +  (fn _ => [ Clarsimp_tac 1,
  39.415  	     merge_box_tac 1,
  39.416               fast_tac (temp_cs addSEs [notE,STL4E]) 1
  39.417  	   ]);
  39.418  
  39.419 -qed_goal "STL6" TLA.thy "<>[]F .& <>[]G .-> <>[](F .& G)"
  39.420 +qed_goal "DmdImpldup" TLA.thy 
  39.421 +   "[| sigma |= []A; sigma |= <>F; |- []A & F --> G |] ==> sigma |= <>G"
  39.422 +   (fn [p1,p2,p3] => [rtac ((p2 RS (p1 RS (temp_use BoxDmd))) RS DmdImplE) 1,
  39.423 +                      rtac p3 1]);
  39.424 +
  39.425 +qed_goal "STL6" TLA.thy "|- <>[]F & <>[]G --> <>[](F & G)"
  39.426    (fn _ => [auto_tac (temp_css addsimps2 [symmetric (temp_rewrite STL5)]),
  39.427 -	    etac (temp_conjimpE linT) 1, atac 1, etac thin_rl 1,
  39.428 +	    dtac (temp_use linT) 1, atac 1, etac thin_rl 1,
  39.429  	    rtac ((temp_unlift DmdDmd) RS iffD1) 1,
  39.430  	    etac disjE 1,
  39.431 -	    etac DmdImplE 1, rtac BoxDmdT 1,
  39.432 -	    (* the second subgoal needs commutativity of .&, which complicates the proof *)
  39.433 +	    etac DmdImplE 1, rtac BoxDmd 1,
  39.434 +	    (* the second subgoal needs commutativity of &, which complicates the proof *)
  39.435  	    etac DmdImplE 1,
  39.436  	    Auto_tac,
  39.437 -	    etac (temp_conjimpE BoxDmdT) 1, atac 1, etac thin_rl 1,
  39.438 +	    dtac (temp_use BoxDmd) 1, atac 1, etac thin_rl 1,
  39.439  	    fast_tac (temp_cs addSEs [DmdImplE]) 1
  39.440  	   ]);
  39.441  
  39.442 @@ -287,55 +311,19 @@
  39.443  (* ------------------------ True / False ----------------------------------------- *)
  39.444  section "Simplification of constants";
  39.445  
  39.446 -qed_goal "BoxTrue" TLA.thy "[](#True)"
  39.447 -   (fn _ => [ fast_tac (temp_cs addSIs [necT]) 1 ]);
  39.448 -
  39.449 -qed_goal "BoxTrue_simp" TLA.thy "([](#True)) .= #True"
  39.450 -   (fn _ => [ fast_tac (temp_cs addSIs [BoxTrue RS tempD]) 1 ]);
  39.451 -
  39.452 -qed_goal "DmdFalse_simp" TLA.thy "(<>(#False)) .= #False"
  39.453 -   (fn _ => [ auto_tac (temp_css addsimps2 [dmd_def, BoxTrue_simp]) ]);
  39.454 -
  39.455 -qed_goal "DmdTrue_simp" TLA.thy "(<>((#True)::temporal)) .= #True"
  39.456 -   (fn _ => [ fast_tac (temp_cs addSIs [ImplDmdD]) 1 ]);
  39.457 -
  39.458 -qed_goal "DmdActTrue_simp" TLA.thy "(<>((#True)::action)) .= #True"
  39.459 -   (fn _ => [ auto_tac (temp_css addsimps2 Init_simps addSIs2 [InitDmdD]) ]);
  39.460 -
  39.461 -qed_goal "BoxFalse_simp" TLA.thy "([]((#False)::temporal)) .= #False"
  39.462 -   (fn _ => [ fast_tac (temp_cs addSDs [STL2D]) 1 ]);
  39.463 -
  39.464 -qed_goal "BoxActFalse_simp" TLA.thy "([]((#False)::action)) .= #False"
  39.465 -   (fn _ => [ auto_tac (temp_css addsimps2 Init_simps addSDs2 [STL2bD]) ]);
  39.466 +qed_goal "BoxConst" TLA.thy "|- ([]#P) = #P"
  39.467 +  (fn _ => [rtac tempI 1,
  39.468 +            case_tac "P" 1,
  39.469 +            auto_tac (temp_css addSIs2 [necT] addDs2 [STL2_gen] 
  39.470 +                               addsimps2 Init_simps)
  39.471 +           ]);
  39.472  
  39.473 -qed_goal "BoxConst_simp" TLA.thy "([]((#P)::temporal)) .= #P"
  39.474 -   (fn _ => [rtac tempI 1,
  39.475 -             case_tac "P" 1,
  39.476 -             auto_tac (temp_css addsimps2 [BoxTrue_simp,BoxFalse_simp])
  39.477 -            ]);
  39.478 -
  39.479 -qed_goal "BoxActConst_simp" TLA.thy "([]((#P)::action)) .= #P"
  39.480 -   (fn _ => [rtac tempI 1,
  39.481 -             case_tac "P" 1,
  39.482 -             auto_tac (temp_css addsimps2 [BoxTrue_simp,BoxActFalse_simp])
  39.483 -            ]);
  39.484 +qed_goalw "DmdConst" TLA.thy [dmd_def] "|- (<>#P) = #P"
  39.485 +  (fn _ => [case_tac "P" 1,
  39.486 +            ALLGOALS (asm_full_simp_tac (simpset() addsimps [BoxConst]))
  39.487 +           ]);
  39.488  
  39.489 -qed_goal "DmdConst_simp" TLA.thy "(<>((#P)::temporal)) .= #P"
  39.490 -   (fn _ => [rtac tempI 1,
  39.491 -             case_tac "P" 1,
  39.492 -             auto_tac (temp_css addsimps2 [DmdTrue_simp,DmdFalse_simp])
  39.493 -            ]);
  39.494 -
  39.495 -qed_goal "DmdActConst_simp" TLA.thy "(<>((#P)::action)) .= #P"
  39.496 -   (fn _ => [rtac tempI 1,
  39.497 -             case_tac "P" 1,
  39.498 -             auto_tac (temp_css addsimps2 [DmdActTrue_simp,DmdFalse_simp])
  39.499 -            ]);
  39.500 -
  39.501 -val temp_simps = map temp_rewrite
  39.502 -                  [BoxTrue_simp,DmdFalse_simp,DmdTrue_simp,
  39.503 -		   DmdActTrue_simp, BoxFalse_simp, BoxActFalse_simp,
  39.504 -		   BoxConst_simp,BoxActConst_simp,DmdConst_simp,DmdActConst_simp];
  39.505 +val temp_simps = map temp_rewrite [BoxConst, DmdConst];
  39.506  
  39.507  (* Make these rewrites active by default *)
  39.508  Addsimps temp_simps;
  39.509 @@ -346,31 +334,31 @@
  39.510  (* ------------------------ Further rewrites ----------------------------------------- *)
  39.511  section "Further rewrites";
  39.512  
  39.513 -qed_goalw "NotBox" TLA.thy [dmd_def] "(.~[]F) .= (<>.~F)"
  39.514 -   (fn _ => [ Auto_tac ]);
  39.515 +qed_goalw "NotBox" TLA.thy [dmd_def] "|- (~[]F) = (<>~F)"
  39.516 +   (fn _ => [ Simp_tac 1 ]);
  39.517  
  39.518 -qed_goalw "NotDmd" TLA.thy [dmd_def] "(.~<>F) .= ([].~F)"
  39.519 -   (fn _ => [ Auto_tac ]);
  39.520 +qed_goalw "NotDmd" TLA.thy [dmd_def] "|- (~<>F) = ([]~F)"
  39.521 +   (fn _ => [ Simp_tac 1 ]);
  39.522  
  39.523  (* These are not by default included in temp_css, because they could be harmful,
  39.524 -   e.g. []F .& .~[]F becomes []F .& <>.~F !! *)
  39.525 +   e.g. []F & ~[]F becomes []F & <>~F !! *)
  39.526  val more_temp_simps =  (map temp_rewrite [STL3, DmdDmd, NotBox, NotDmd])
  39.527                         @ (map (fn th => (temp_unlift th) RS eq_reflection)
  39.528  		         [NotBox, NotDmd]);
  39.529  
  39.530 -qed_goal "BoxDmdBox" TLA.thy "([]<>[]F) .= (<>[]F)"
  39.531 -   (fn _ => [ auto_tac (temp_css addSDs2 [STL2D]),
  39.532 +qed_goal "BoxDmdBox" TLA.thy "|- ([]<>[]F) = (<>[]F)"
  39.533 +   (fn _ => [ auto_tac (temp_css addSDs2 [STL2]),
  39.534                rtac ccontr 1,
  39.535 -              subgoal_tac "sigma |= <>[][]F .& <>[].~[]F" 1,
  39.536 +              subgoal_tac "sigma |= <>[][]F & <>[]~[]F" 1,
  39.537                etac thin_rl 1,
  39.538                Auto_tac,
  39.539 -	      etac (temp_conjimpE STL6) 1, atac 1,
  39.540 +	      dtac (temp_use STL6) 1, atac 1,
  39.541  	      Asm_full_simp_tac 1,
  39.542  	      ALLGOALS (asm_full_simp_tac (simpset() addsimps more_temp_simps))
  39.543  	    ]);
  39.544  
  39.545 -qed_goalw "DmdBoxDmd" TLA.thy [dmd_def] "(<>[]<>F) .= ([]<>F)"
  39.546 -  (fn _ => [auto_tac (temp_css addsimps2 [temp_rewrite (rewrite_rule [dmd_def] BoxDmdBox)])]);
  39.547 +qed_goalw "DmdBoxDmd" TLA.thy [dmd_def] "|- (<>[]<>F) = ([]<>F)"
  39.548 +  (fn _ => [ auto_tac (temp_css addsimps2 [rewrite_rule [dmd_def] BoxDmdBox]) ]);
  39.549  
  39.550  val more_temp_simps = more_temp_simps @ (map temp_rewrite [BoxDmdBox, DmdBoxDmd]);
  39.551  
  39.552 @@ -378,31 +366,25 @@
  39.553  (* ------------------------ Miscellaneous ----------------------------------- *)
  39.554  
  39.555  qed_goal "BoxOr" TLA.thy 
  39.556 -   "!!sigma. [| (sigma |= []F .| []G) |] ==> (sigma |= [](F .| G))"
  39.557 +   "!!sigma. [| sigma |= []F | []G |] ==> sigma |= [](F | G)"
  39.558     (fn _ => [ fast_tac (temp_cs addSEs [STL4E]) 1 ]);
  39.559  
  39.560 -qed_goal "DBImplBD" TLA.thy "<>[](F::temporal) .-> []<>F"
  39.561 -  (fn _ => [Auto_tac,
  39.562 +(* "persistently implies infinitely often" *)
  39.563 +qed_goal "DBImplBD" TLA.thy "|- <>[]F --> []<>F"
  39.564 +  (fn _ => [Clarsimp_tac 1,
  39.565  	    rtac ccontr 1,
  39.566 -	    old_auto_tac (temp_css addsimps2 more_temp_simps 
  39.567 -			           addEs2 [temp_conjimpE STL6])
  39.568 -	   ]);
  39.569 -
  39.570 -(* Although the script is the same, the derivation isn't polymorphic and doesn't
  39.571 -   work for other types of formulas (uses STL2).
  39.572 -*)
  39.573 -qed_goal "DBImplBDAct" TLA.thy "<>[](A::action) .-> []<>A"
  39.574 -  (fn _ => [Auto_tac,
  39.575 -	    rtac ccontr 1,
  39.576 -	    old_auto_tac (temp_css addsimps2 more_temp_simps addEs2 [temp_conjimpE STL6])
  39.577 +            asm_full_simp_tac (simpset() addsimps more_temp_simps) 1,
  39.578 +            dtac (temp_use STL6) 1, atac 1,
  39.579 +            Asm_full_simp_tac 1
  39.580  	   ]);
  39.581  
  39.582  qed_goal "BoxDmdDmdBox" TLA.thy
  39.583 -   "!!sigma. [| (sigma |= []<>F); (sigma |= <>[]G) |] ==> (sigma |= []<>(F .& G))"
  39.584 -   (fn _ => [rtac ccontr 1,
  39.585 +   "|- []<>F & <>[]G --> []<>(F & G)"
  39.586 +   (fn _ => [Clarsimp_tac 1,
  39.587 +             rtac ccontr 1,
  39.588  	     rewrite_goals_tac more_temp_simps,
  39.589 -	     etac (temp_conjimpE STL6) 1, atac 1,
  39.590 -	     subgoal_tac "sigma |= <>[].~F" 1,
  39.591 +	     dtac (temp_use STL6) 1, atac 1,
  39.592 +	     subgoal_tac "sigma |= <>[]~F" 1,
  39.593  	     force_tac (temp_css addsimps2 [dmd_def]) 1,
  39.594  	     fast_tac (temp_cs addEs [DmdImplE,STL4E]) 1
  39.595  	    ]);
  39.596 @@ -414,65 +396,78 @@
  39.597  section "priming";
  39.598  
  39.599  (* ------------------------ TLA2 ------------------------------------------- *)
  39.600 -qed_goal "STL2bD_pr" TLA.thy
  39.601 -  "!!sigma. (sigma |= []P) ==> (sigma |= Init(P .& P`))"
  39.602 -  (fn _ => [rewrite_goals_tac Init_simps,
  39.603 -	    fast_tac (temp_cs addSIs [temp_mp primeI, STL2bD]) 1]);
  39.604 +qed_goal "STL2_pr" TLA.thy
  39.605 +  "|- []P --> Init P & Init P`"
  39.606 +  (fn _ => [fast_tac (temp_cs addSIs [primeI, STL2_gen]) 1]);
  39.607  
  39.608  (* Auxiliary lemma allows priming of boxed actions *)
  39.609 -qed_goal "BoxPrime" TLA.thy "[]P .-> [](P .& P`)"
  39.610 -  (fn _ => [Auto_tac,
  39.611 +qed_goal "BoxPrime" TLA.thy "|- []P --> []($P & P$)"
  39.612 +  (fn _ => [Clarsimp_tac 1,
  39.613  	    etac dup_boxE 1,
  39.614 -	    auto_tac (temp_css addsimps2 [boxact_def]
  39.615 -		               addSIs2 [STL2bD_pr] addSEs2 [STL4E])
  39.616 +            rewtac boxInit_act,
  39.617 +            etac STL4E 1,
  39.618 +	    auto_tac (temp_css addsimps2 Init_simps addSDs2 [STL2_pr])
  39.619  	   ]);
  39.620  
  39.621 -qed_goal "TLA2" TLA.thy "P .& P` .-> Q  ==>  []P .-> []Q"
  39.622 -  (fn prems => [fast_tac (temp_cs addSIs prems addDs [temp_mp BoxPrime] addEs [STL4E]) 1]);
  39.623 +qed_goal "TLA2" TLA.thy "|- $P & P$ --> A  ==>  |- []P --> []A"
  39.624 +  (fn prems => [Clarsimp_tac 1,
  39.625 +                dtac (temp_use BoxPrime) 1,
  39.626 +                auto_tac (temp_css addsimps2 [Init_stp_act_rev] addSIs2 prems addSEs2 [STL4E])
  39.627 +               ]);
  39.628  
  39.629  qed_goal "TLA2E" TLA.thy 
  39.630 -   "[| (sigma |= []P); P .& P` .-> Q |] ==> (sigma |= []Q)"
  39.631 -   (fn prems => [REPEAT (resolve_tac (prems @ (prems RL [temp_mp TLA2])) 1)]);
  39.632 +   "[| sigma |= []P; |- $P & P$ --> A |] ==> sigma |= []A"
  39.633 +   (fn prems => [REPEAT (resolve_tac (prems @ (prems RL [temp_use TLA2])) 1)]);
  39.634  
  39.635 -qed_goalw "DmdPrime" TLA.thy [dmd_def] "(<>P`) .-> (<>P)"
  39.636 +qed_goalw "DmdPrime" TLA.thy [dmd_def] "|- (<>P`) --> (<>P)"
  39.637     (fn _ => [ fast_tac (temp_cs addSEs [TLA2E]) 1 ]);
  39.638  
  39.639 +bind_thm("PrimeDmd", (temp_use InitDmd_gen) RS (temp_use DmdPrime));
  39.640  
  39.641  (* ------------------------ INV1, stable --------------------------------------- *)
  39.642  section "stable, invariant";
  39.643  
  39.644  qed_goal "ind_rule" TLA.thy
  39.645 -   "[| (sigma |= []H); (sigma |= Init(P)); H .-> (Init(P) .& .~[]F .-> Init(P`) .& F) |] \
  39.646 -\   ==> (sigma |= []F)"
  39.647 -   (fn prems => [rtac ((temp_mp indT) RS mp) 1,
  39.648 +   "[| sigma |= []H; sigma |= Init P; |- H --> (Init P & ~[]F --> Init(P`) & F) |] \
  39.649 +\   ==> sigma |= []F"
  39.650 +   (fn prems => [rtac (temp_use indT) 1,
  39.651  		 REPEAT (resolve_tac (prems @ (prems RL [STL4E])) 1)]);
  39.652 -		 
  39.653 +
  39.654 +qed_goalw "box_stp_act" TLA.thy [boxInit_act] "|- ([]$P) = ([]P)"
  39.655 +  (K [simp_tac (simpset() addsimps Init_simps) 1]);
  39.656 +bind_thm("box_stp_actI", zero_var_indexes ((temp_use box_stp_act) RS iffD2));
  39.657 +bind_thm("box_stp_actD", zero_var_indexes ((temp_use box_stp_act) RS iffD1));
  39.658  
  39.659 -qed_goalw "INV1" TLA.thy [stable_def,boxact_def] 
  39.660 -  "Init(P) .& stable(P) .-> []P"
  39.661 -  (K [force_tac (temp_css addsimps2 Init_simps addEs2 [ind_rule]) 1]);
  39.662 -bind_thm("INV1I", temp_conjmp INV1);
  39.663 +val more_temp_simps = (temp_rewrite box_stp_act)::more_temp_simps;
  39.664  
  39.665 -qed_goalw "StableL" TLA.thy [stable_def]
  39.666 -   "(P .& A .-> P`) ==> ([]A .-> stable(P))"
  39.667 -   (fn [prem] => [fast_tac (temp_cs addSIs [action_mp prem] addSEs [STL4E]) 1]);
  39.668 +qed_goalw "INV1" TLA.thy [stable_def,boxInit_stp,boxInit_act] 
  39.669 +  "|- (Init P) --> (stable P) --> []P"
  39.670 +  (K [Clarsimp_tac 1,
  39.671 +      etac ind_rule 1,
  39.672 +      auto_tac (temp_css addsimps2 Init_simps addEs2 [ind_rule])
  39.673 +     ]);
  39.674 +
  39.675 +qed_goalw "StableT" TLA.thy [stable_def]
  39.676 +   "|- $P & A --> P` ==> |- []A --> stable P"
  39.677 +   (fn [prem] => [fast_tac (temp_cs addSEs [STL4E] addIs [prem]) 1]);
  39.678  
  39.679  qed_goal "Stable" TLA.thy
  39.680 -   "[| (sigma |= []A); P .& A .-> P` |] ==> (sigma |= stable P)"
  39.681 -   (fn prems => [ REPEAT (resolve_tac (prems @ [temp_mp StableL]) 1) ]);
  39.682 +   "[| sigma |= []A; |- $P & A --> P` |] ==> sigma |= stable P"
  39.683 +   (fn prems => [ REPEAT (resolve_tac (prems @ [temp_use StableT]) 1) ]);
  39.684  
  39.685  (* Generalization of INV1 *)
  39.686  qed_goalw "StableBox" TLA.thy [stable_def]
  39.687 -   "!!sigma. (sigma |= stable P) ==> (sigma |= [](Init P .-> []P))"
  39.688 -   (K [etac dup_boxE 1,
  39.689 -       force_tac (temp_css addsimps2 [stable_def] addEs2 [STL4E, INV1I]) 1]);
  39.690 -     
  39.691 -(* useful for WF2 / SF2 *)
  39.692 +   "|- (stable P) --> [](Init P --> []P)"
  39.693 +   (K [Clarsimp_tac 1,
  39.694 +       etac dup_boxE 1,
  39.695 +       force_tac (temp_css addsimps2 [stable_def] addEs2 [STL4E, INV1]) 1]);
  39.696 +
  39.697  qed_goal "DmdStable" TLA.thy 
  39.698 -   "!!sigma. [| (sigma |= stable P); (sigma |= <>P) |] ==> (sigma |= <>[]P)"
  39.699 -   (fn _ => [rtac DmdImpl2 1,
  39.700 -	     etac StableBox 2,
  39.701 -	     auto_tac (temp_css addsimps2 [DmdAct])
  39.702 +   "|- (stable P) & <>P --> <>[]P"
  39.703 +   (fn _ => [Clarsimp_tac 1,
  39.704 +             rtac DmdImpl2 1,
  39.705 +	     etac (temp_use StableBox) 2,
  39.706 +	     asm_simp_tac (simpset() addsimps [dmdInitD]) 1
  39.707  	    ]);
  39.708  
  39.709  (* ---------------- (Semi-)automatic invariant tactics ---------------------- *)
  39.710 @@ -481,11 +476,11 @@
  39.711  fun inv_tac css = SELECT_GOAL
  39.712       (EVERY [auto_tac css,
  39.713               TRY (merge_box_tac 1),
  39.714 -             rtac INV1I 1, (* fail if the goal is not a box *)
  39.715 +             rtac (temp_use INV1) 1, (* fail if the goal is not a box *)
  39.716               TRYALL (etac Stable)]);
  39.717  
  39.718  (* auto_inv_tac applies inv_tac and then tries to attack the subgoals;
  39.719 -   in simple cases it may be able to handle goals like MyProg .-> []Inv.
  39.720 +   in simple cases it may be able to handle goals like |- MyProg --> []Inv.
  39.721     In these simple cases the simplifier seems to be more useful than the
  39.722     auto-tactic, which applies too much propositional logic and simplifies
  39.723     too late.
  39.724 @@ -493,13 +488,14 @@
  39.725  
  39.726  fun auto_inv_tac ss = SELECT_GOAL
  39.727      ((inv_tac (claset(),ss) 1) THEN
  39.728 -     (TRYALL (action_simp_tac (ss addsimps [Init_def,square_def]) [] [])));
  39.729 +     (TRYALL (action_simp_tac (ss addsimps [Init_stp,Init_act]) [] [squareE])));
  39.730  
  39.731  
  39.732  qed_goalw "unless" TLA.thy [dmd_def]
  39.733 -   "!!sigma. (sigma |= [](P .-> P` .| Q`)) ==> (sigma |= stable P .| <>Q`)"
  39.734 -   (fn _ => [action_simp_tac (simpset()) [disjCI] [] 1,
  39.735 +   "|- []($P --> P` | Q`) --> (stable P) | <>Q"
  39.736 +   (fn _ => [clarsimp_tac (temp_css addSDs2 [BoxPrime]) 1,
  39.737  	     merge_box_tac 1,
  39.738 +             etac swap 1,
  39.739  	     fast_tac (temp_cs addSEs [Stable]) 1
  39.740  	    ]);
  39.741  
  39.742 @@ -507,73 +503,72 @@
  39.743  (* --------------------- Recursive expansions --------------------------------------- *)
  39.744  section "recursive expansions";
  39.745  
  39.746 -(* Recursive expansions of [] and <>, restricted to state predicates to avoid looping *)
  39.747 -qed_goal "BoxRec" TLA.thy "([]$P) .= (Init($P) .& ([]P$))"
  39.748 -   (fn _ => [auto_tac (temp_css addSIs2 [STL2bD]),
  39.749 +(* Recursive expansions of [] and <> for state predicates *)
  39.750 +qed_goal "BoxRec" TLA.thy "|- ([]P) = (Init P & []P`)"
  39.751 +   (fn _ => [auto_tac (temp_css addSIs2 [STL2_gen]),
  39.752  	     fast_tac (temp_cs addSEs [TLA2E]) 1,
  39.753 -	     auto_tac (temp_css addsimps2 [stable_def] addSEs2 [INV1I,STL4E])
  39.754 +	     auto_tac (temp_css addsimps2 [stable_def] addSEs2 [INV1,STL4E])
  39.755  	    ]);
  39.756  
  39.757 -qed_goalw "DmdRec" TLA.thy [dmd_def] "(<>$P) .= (Init($P) .| (<>P$))" (K [
  39.758 -	     Auto_tac,
  39.759 -	     etac notE 1,
  39.760 -	     force_tac (temp_css addsimps2 (stable_def::Init_simps)
  39.761 -				             addIs2 [INV1I] addEs2 [STL4E]) 1,
  39.762 -	     force_tac (temp_css addsimps2 Init_simps addSDs2 [STL2bD]) 1,
  39.763 -	     fast_tac (temp_cs addSEs [notE,TLA2E]) 1
  39.764 -	    ]);
  39.765 +qed_goalw "DmdRec" TLA.thy [dmd_def, temp_rewrite BoxRec] "|- (<>P) = (Init P | <>P`)" 
  39.766 +  (K [ auto_tac (temp_css addsimps2 Init_simps) ]);
  39.767  
  39.768  qed_goal "DmdRec2" TLA.thy
  39.769 - "!!sigma. [| (sigma |= <>($P)); (sigma |= [](.~P$)) |] ==> (sigma |= Init($P))"
  39.770 -   (K [      dtac ((temp_unlift DmdRec) RS iffD1) 1,
  39.771 -	     force_tac (temp_css addsimps2 [dmd_def]) 1]);
  39.772 + "!!sigma. [| sigma |= <>P; sigma |= []~P` |] ==> sigma |= Init P"
  39.773 +   (K [ force_tac (temp_css addsimps2 [DmdRec,dmd_def]) 1]);
  39.774  
  39.775 -(* The "=>" part of the following is a little intricate. *)
  39.776 -qed_goal "InfinitePrime" TLA.thy "([]<>$P) .= ([]<>P$)"
  39.777 +(* The "-->" part of the following is a little intricate. *)
  39.778 +qed_goal "InfinitePrime" TLA.thy "|- ([]<>P) = ([]<>P`)"
  39.779     (fn _ => [Auto_tac,
  39.780  	     rtac classical 1,
  39.781 -	     rtac (temp_mp DBImplBDAct) 1,
  39.782 -	     subgoal_tac "sigma |= <>[]$P" 1,
  39.783 +	     rtac (temp_use DBImplBD) 1,
  39.784 +	     subgoal_tac "sigma |= <>[]P" 1,
  39.785  	     fast_tac (temp_cs addSEs [DmdImplE,TLA2E]) 1,
  39.786 -	     subgoal_tac "sigma |= <>[](<>$P .& [].~P$)" 1,
  39.787 -	     force_tac (temp_css addsimps2 [boxact_def]
  39.788 +	     subgoal_tac "sigma |= <>[](<>P & []~P`)" 1,
  39.789 +	     force_tac (temp_css addsimps2 [boxInit_stp]
  39.790  			             addSEs2 [DmdImplE,STL4E,DmdRec2]) 1,
  39.791 -	     force_tac (temp_css addSIs2 [temp_mp STL6] addsimps2 more_temp_simps) 1,
  39.792 -	     fast_tac (temp_cs addIs [temp_mp DmdPrime] addSEs [STL4E]) 1
  39.793 +	     force_tac (temp_css addSIs2 [STL6] addsimps2 more_temp_simps) 1,
  39.794 +	     fast_tac (temp_cs addIs [DmdPrime] addSEs [STL4E]) 1
  39.795  	    ]);
  39.796  
  39.797 +qed_goal "InfiniteEnsures" TLA.thy
  39.798 +   "[| sigma |= []N; sigma |= []<>A; |- A & N --> P` |] ==> sigma |= []<>P"
  39.799 +   (fn prems => [rewtac (temp_rewrite InfinitePrime),
  39.800 +                 rtac InfImpl 1,
  39.801 +                 REPEAT (resolve_tac prems 1)
  39.802 +                ]);
  39.803 +
  39.804  (* ------------------------ fairness ------------------------------------------- *)
  39.805  section "fairness";
  39.806  
  39.807  (* alternative definitions of fairness *)
  39.808  qed_goalw "WF_alt" TLA.thy [WF_def,dmd_def] 
  39.809 -   "WF(A)_v .= (([]<>.~$(Enabled(<A>_v))) .| []<><A>_v)"
  39.810 +   "|- WF(A)_v = ([]<>~Enabled(<A>_v) | []<><A>_v)"
  39.811     (fn _ => [ fast_tac temp_cs 1 ]);
  39.812  
  39.813  qed_goalw "SF_alt" TLA.thy [SF_def,dmd_def]
  39.814 -   "SF(A)_v .= ((<>[].~$(Enabled(<A>_v))) .| []<><A>_v)"
  39.815 +   "|- SF(A)_v = (<>[]~Enabled(<A>_v) | []<><A>_v)"
  39.816     (fn _ => [ fast_tac temp_cs 1 ]);
  39.817  
  39.818  (* theorems to "box" fairness conditions *)
  39.819 -qed_goal "BoxWFI" TLA.thy
  39.820 -   "!!sigma. (sigma |= WF(A)_v) ==> (sigma |= []WF(A)_v)"
  39.821 -   (fn _ => [ auto_tac (temp_css addsimps2 (temp_rewrite WF_alt::more_temp_simps) addSIs2 [BoxOr]) ]);
  39.822 +qed_goal "BoxWFI" TLA.thy "|- WF(A)_v --> []WF(A)_v"
  39.823 +   (fn _ => [ auto_tac (temp_css addsimps2 (WF_alt::more_temp_simps) 
  39.824 +                                 addSIs2 [BoxOr]) ]);
  39.825  
  39.826 -qed_goal "WF_Box" TLA.thy "([]WF(A)_v) .= WF(A)_v"
  39.827 -  (fn prems => [ fast_tac (temp_cs addSIs [BoxWFI] addSDs [STL2D]) 1 ]);
  39.828 +qed_goal "WF_Box" TLA.thy "|- ([]WF(A)_v) = WF(A)_v"
  39.829 +  (fn prems => [ fast_tac (temp_cs addSIs [BoxWFI] addSDs [STL2]) 1 ]);
  39.830  
  39.831 -qed_goal "BoxSFI" TLA.thy
  39.832 -   "!!sigma. (sigma |= SF(A)_v) ==> (sigma |= []SF(A)_v)"
  39.833 -   (fn _ => [ auto_tac (temp_css addsimps2 (temp_rewrite SF_alt::more_temp_simps) addSIs2 [BoxOr]) ]);
  39.834 +qed_goal "BoxSFI" TLA.thy "|- SF(A)_v --> []SF(A)_v"
  39.835 +   (fn _ => [ auto_tac (temp_css addsimps2 (SF_alt::more_temp_simps) 
  39.836 +                                 addSIs2 [BoxOr]) ]);
  39.837  
  39.838 -qed_goal "SF_Box" TLA.thy "([]SF(A)_v) .= SF(A)_v"
  39.839 -  (fn prems => [ fast_tac (temp_cs addSIs [BoxSFI] addSDs [STL2D]) 1 ]);
  39.840 +qed_goal "SF_Box" TLA.thy "|- ([]SF(A)_v) = SF(A)_v"
  39.841 +  (fn prems => [ fast_tac (temp_cs addSIs [BoxSFI] addSDs [STL2]) 1 ]);
  39.842  
  39.843  val more_temp_simps = more_temp_simps @ (map temp_rewrite [WF_Box, SF_Box]);
  39.844  
  39.845 -qed_goalw "SFImplWF" TLA.thy [SF_def,WF_def]
  39.846 -  "!!sigma. (sigma |= SF(A)_v) ==> (sigma |= WF(A)_v)"
  39.847 -  (fn _ => [ fast_tac (temp_cs addSDs [temp_mp DBImplBDAct]) 1 ]);
  39.848 +qed_goalw "SFImplWF" TLA.thy [SF_def,WF_def] "|- SF(A)_v --> WF(A)_v"
  39.849 +  (fn _ => [ fast_tac (temp_cs addSDs [DBImplBD]) 1 ]);
  39.850  
  39.851  (* A tactic that "boxes" all fairness conditions. Apply more_temp_simps to "unbox". *)
  39.852  val box_fair_tac = SELECT_GOAL (REPEAT (dresolve_tac [BoxWFI,BoxSFI] 1));
  39.853 @@ -583,313 +578,321 @@
  39.854  
  39.855  section "~>";
  39.856  
  39.857 -qed_goalw "leadsto_init" TLA.thy [leadsto]
  39.858 -   "!!sigma. [| (sigma |= Init P); (sigma |= P ~> Q) |] ==> (sigma |= <>Q)"
  39.859 -   (fn _ => [ fast_tac (temp_cs addSDs [temp_mp STL2]) 1 ]);
  39.860 +qed_goalw "leadsto_init" TLA.thy [leadsto_def]
  39.861 +   "|- (Init F) & (F ~> G) --> <>G"
  39.862 +   (fn _ => [ auto_tac (temp_css addSDs2 [STL2]) ]);
  39.863  
  39.864 -qed_goalw "streett_leadsto" TLA.thy [leadsto]
  39.865 -   "([]<>P .-> []<>Q) .= (<>(P ~> Q))" (K [
  39.866 +(* |- F & (F ~> G) --> <>G *)
  39.867 +bind_thm("leadsto_init_temp", 
  39.868 +         rewrite_rule Init_simps (read_instantiate [("'a","behavior")] leadsto_init));
  39.869 +
  39.870 +qed_goalw "streett_leadsto" TLA.thy [leadsto_def]
  39.871 +   "|- ([]<>Init F --> []<>G) = (<>(F ~> G))" (K [
  39.872               Auto_tac,
  39.873 -             asm_full_simp_tac (simpset() addsimps boxact_def::more_temp_simps) 1,
  39.874 -             force_tac (temp_css addSEs2 [DmdImplE,STL4E] 
  39.875 -                                             addsimps2 Init_simps) 1,
  39.876 -             force_tac (temp_css addSIs2 [ImplDmdD] addSEs2 [STL4E]) 1,
  39.877 -             subgoal_tac "sigma |= []<><>Q" 1,
  39.878               asm_full_simp_tac (simpset() addsimps more_temp_simps) 1,
  39.879 -             rewtac (temp_rewrite DmdAct),
  39.880 -             dtac BoxDmdDmdBox 1, atac 1,
  39.881 -             auto_tac (temp_css addSEs2 [DmdImplE,STL4E])
  39.882 +             fast_tac (temp_cs addSEs [DmdImplE,STL4E]) 1,
  39.883 +             fast_tac (temp_cs addSIs [InitDmd] addSEs [STL4E]) 1,
  39.884 +             subgoal_tac "sigma |= []<><>G" 1,
  39.885 +             asm_full_simp_tac (simpset() addsimps more_temp_simps) 1,
  39.886 +             dtac (temp_use BoxDmdDmdBox) 1, atac 1,
  39.887 +             fast_tac (temp_cs addSEs [DmdImplE,STL4E]) 1
  39.888              ]);
  39.889  
  39.890  qed_goal "leadsto_infinite" TLA.thy
  39.891 -   "!!sigma. [| (sigma |= []<>P); (sigma |= P ~> Q) |] ==> (sigma |= []<>Q)"
  39.892 -   (fn _ => [rtac ((temp_unlift streett_leadsto) RS iffD2 RS mp) 1,
  39.893 -             auto_tac (temp_css addSIs2 [ImplDmdD])
  39.894 +   "|- []<>F & (F ~> G) --> []<>G"
  39.895 +   (fn _ => [Clarsimp_tac 1,
  39.896 +             etac ((temp_use InitDmd) RS 
  39.897 +                   ((temp_unlift streett_leadsto) RS iffD2 RS mp)) 1,
  39.898 +             asm_simp_tac (simpset() addsimps [dmdInitD]) 1
  39.899              ]);
  39.900  
  39.901  (* In particular, strong fairness is a Streett condition. The following
  39.902     rules are sometimes easier to use than WF2 or SF2 below.
  39.903  *)
  39.904  qed_goalw "leadsto_SF" TLA.thy [SF_def]
  39.905 -  "!!sigma. (sigma |= $(Enabled(<A>_v)) ~> <A>_v) ==> sigma |= SF(A)_v"
  39.906 -        (K [REPEAT(step_tac temp_cs 1),
  39.907 -            rtac leadsto_infinite 1,
  39.908 -            ALLGOALS atac]);
  39.909 +  "|- (Enabled(<A>_v) ~> <A>_v) --> SF(A)_v"
  39.910 +  (K [clarsimp_tac (temp_css addSEs2 [leadsto_infinite]) 1]);
  39.911  
  39.912 -bind_thm("leadsto_WF", leadsto_SF RS SFImplWF);
  39.913 +qed_goal "leadsto_WF" TLA.thy 
  39.914 +  "|- (Enabled(<A>_v) ~> <A>_v) --> WF(A)_v"
  39.915 +  (K [ clarsimp_tac (temp_css addSIs2 [SFImplWF, leadsto_SF]) 1 ]);
  39.916  
  39.917  (* introduce an invariant into the proof of a leadsto assertion.
  39.918 -   []I => ((P ~> Q)  =  (P /\ I ~> Q))
  39.919 +   []I --> ((P ~> Q)  =  (P /\ I ~> Q))
  39.920  *)
  39.921 -qed_goalw "INV_leadsto" TLA.thy [leadsto]
  39.922 -   "!!sigma. [| (sigma |= []I); (sigma |= (P .& I) ~> Q) |] ==> (sigma |= P ~> Q)"
  39.923 -   (fn _ => [etac STL4Edup 1, atac 1,
  39.924 -	     auto_tac (temp_css addsimps2 [Init_def] addSDs2 [STL2bD])
  39.925 +qed_goalw "INV_leadsto" TLA.thy [leadsto_def]
  39.926 +   "|- []I & (P & I ~> Q) --> (P ~> Q)"
  39.927 +   (fn _ => [Clarsimp_tac 1,
  39.928 +             etac STL4Edup 1, atac 1,
  39.929 +	     auto_tac (temp_css addsimps2 Init_simps addSDs2 [STL2_gen])
  39.930  	    ]);
  39.931  
  39.932 -qed_goalw "leadsto_classical" TLA.thy [leadsto,dmd_def]
  39.933 -   "!!sigma. (sigma |= [](Init P .& [].~Q .-> <>Q)) ==> (sigma |= P ~> Q)"
  39.934 -   (fn _ => [fast_tac (temp_cs addSEs [STL4E]) 1]);
  39.935 +qed_goalw "leadsto_classical" TLA.thy [leadsto_def,dmd_def]
  39.936 +   "|- (Init F & []~G ~> G) --> (F ~> G)"
  39.937 +   (fn _ => [force_tac (temp_css addsimps2 Init_simps addSEs2 [STL4E]) 1]);
  39.938  
  39.939 -qed_goalw "leadsto_false" TLA.thy [leadsto]
  39.940 -  "(P ~> #False) .= ([] .~P)"
  39.941 -  (fn _ => [ auto_tac (temp_css addsimps2 boxact_def::Init_simps) ]);
  39.942 +qed_goalw "leadsto_false" TLA.thy [leadsto_def]
  39.943 +  "|- (F ~> #False) = ([]~F)"
  39.944 +  (fn _ => [ simp_tac (simpset() addsimps [boxNotInitD]) 1 ]);
  39.945 +
  39.946 +qed_goalw "leadsto_exists" TLA.thy [leadsto_def]
  39.947 +  "|- ((? x. F x) ~> G) = (!x. (F x ~> G))"
  39.948 +  (K [auto_tac (temp_css addsimps2 allT::Init_simps addSEs2 [STL4E])]);
  39.949 +
  39.950  
  39.951  (* basic leadsto properties, cf. Unity *)
  39.952  
  39.953 -qed_goal "ImplLeadsto" TLA.thy
  39.954 -   "!!sigma. (sigma |= [](P .-> Q)) ==> (sigma |= (P ~> Q))"
  39.955 -   (fn _ => [etac INV_leadsto 1, rewtac leadsto,
  39.956 -	     rtac (temp_unlift necT) 1,
  39.957 -	     auto_tac (temp_css addSIs2 [InitDmdD] addsimps2 [Init_def])
  39.958 +qed_goalw "ImplLeadsto_gen" TLA.thy [leadsto_def]
  39.959 +   "|- [](Init F --> Init G) --> (F ~> G)"
  39.960 +   (fn _ => [auto_tac (temp_css addSIs2 [InitDmd_gen] 
  39.961 +                                addSEs2 [STL4E_gen] addsimps2 Init_simps)
  39.962  	    ]);
  39.963  
  39.964 -qed_goal "EnsuresLeadsto" TLA.thy
  39.965 -   "A .& P .-> Q` ==> []A .-> (P ~> Q)" (fn [prem] => [
  39.966 -		  auto_tac (temp_css addSEs2 [INV_leadsto]),
  39.967 -		  rewtac leadsto,
  39.968 - 		  auto_tac (temp_css addSIs2 [temp_unlift necT]),
  39.969 -		  rtac (temp_mp DmdPrime) 1, 
  39.970 -		  rtac InitDmdD 1,
  39.971 -		  force_tac (action_css addsimps2 [Init_def] 
  39.972 -				addSIs2 [action_mp prem]) 1]);
  39.973 +bind_thm("ImplLeadsto",
  39.974 +         rewrite_rule Init_simps 
  39.975 +             (read_instantiate [("'a","behavior"), ("'b","behavior")] ImplLeadsto_gen));
  39.976 +
  39.977 +qed_goal "ImplLeadsto_simple" TLA.thy
  39.978 +  "|- F --> G ==> |- F ~> G"
  39.979 +  (fn [prem] => [auto_tac (temp_css addsimps2 [Init_def] 
  39.980 +                                    addSIs2 [ImplLeadsto_gen,necT,prem])]);
  39.981 +
  39.982 +qed_goalw "EnsuresLeadsto" TLA.thy [leadsto_def]
  39.983 +   "|- A & $P --> Q` ==> |- []A --> (P ~> Q)" (fn [prem] => [
  39.984 +		  clarsimp_tac (temp_css addSEs2 [INV_leadsto]) 1, 
  39.985 +                  etac STL4E_gen 1,
  39.986 +                  auto_tac (temp_css addsimps2 Init_defs
  39.987 +                                     addSIs2 [PrimeDmd, prem])
  39.988 +                 ]);
  39.989 +
  39.990 +qed_goalw "EnsuresLeadsto2" TLA.thy [leadsto_def]
  39.991 +   "|- []($P --> Q`) --> (P ~> Q)"
  39.992 +   (fn _ => [Clarsimp_tac 1,
  39.993 +             etac STL4E_gen 1,
  39.994 +             auto_tac (temp_css addsimps2 Init_simps addSIs2 [PrimeDmd])
  39.995 +            ]);
  39.996  
  39.997 -qed_goalw "EnsuresLeadsto2" TLA.thy [leadsto]
  39.998 -   "!!sigma. sigma |= [](P .-> Q`) ==> sigma |= P ~> Q"
  39.999 -   (fn _ => [subgoal_tac "sigma |= []Init(P .-> Q`)" 1,
 39.1000 -             etac STL4E 1,
 39.1001 -             ALLGOALS (force_tac (temp_css addsimps2 boxact_def::Init_simps 
 39.1002 -                          addIs2 [(temp_mp InitDmd) RS (temp_mp DmdPrime)]))]);
 39.1003 -             
 39.1004 +qed_goalw "ensures" TLA.thy [leadsto_def]
 39.1005 +  "[| |- $P & N --> P` | Q`; \
 39.1006 +\     |- ($P & N) & A --> Q` \
 39.1007 +\  |] ==> |- []N & []([]P --> <>A) --> (P ~> Q)"
 39.1008 +  (fn [p1,p2] => [Clarsimp_tac 1,
 39.1009 +                  etac STL4Edup 1, atac 1,
 39.1010 +                  Clarsimp_tac 1,
 39.1011 +                  subgoal_tac "sigmaa |= []($P --> P` | Q`)" 1,
 39.1012 +                   dtac (temp_use unless) 1,
 39.1013 +                   clarsimp_tac (temp_css addSDs2 [INV1]) 1,
 39.1014 +                   rtac ((temp_use (p2 RS DmdImpl)) RS (temp_use DmdPrime)) 1,
 39.1015 +                   force_tac (temp_css addSIs2 [BoxDmd_simple]
 39.1016 +                                       addsimps2 [split_box_conj,box_stp_act]) 1,
 39.1017 +                  force_tac (temp_css addEs2 [STL4E] addDs2 [p1]) 1
 39.1018 +                 ]);
 39.1019 +
 39.1020 +qed_goal "ensures_simple" TLA.thy
 39.1021 +  "[| |- $P & N --> P` | Q`; \
 39.1022 +\     |- ($P & N) & A --> Q` \
 39.1023 +\  |] ==> |- []N & []<>A --> (P ~> Q)"
 39.1024 +  (fn prems => [Clarsimp_tac 1,
 39.1025 +                rtac (temp_use ensures) 1,
 39.1026 +                TRYALL (ares_tac prems),
 39.1027 +                force_tac (temp_css addSEs2 [STL4E]) 1
 39.1028 +               ]);
 39.1029 +
 39.1030  qed_goal "EnsuresInfinite" TLA.thy
 39.1031 -   "[| (sigma |= []<>P); (sigma |= []A); A .& P .-> Q` |] ==> (sigma |= []<>Q)"
 39.1032 -   (fn prems => [REPEAT (resolve_tac (prems @ [leadsto_infinite,
 39.1033 -					       temp_mp EnsuresLeadsto]) 1)]);
 39.1034 +   "[| sigma |= []<>P; sigma |= []A; |- A & $P --> Q` |] ==> sigma |= []<>Q"
 39.1035 +   (fn prems => [REPEAT (resolve_tac (prems @ [temp_use leadsto_infinite,
 39.1036 +					       temp_use EnsuresLeadsto]) 1)]);
 39.1037 +
 39.1038  
 39.1039  (*** Gronning's lattice rules (taken from TLP) ***)
 39.1040  section "Lattice rules";
 39.1041  
 39.1042 -qed_goalw "LatticeReflexivity" TLA.thy [leadsto] "F ~> F"
 39.1043 -   (fn _ => [REPEAT (resolve_tac [necT,InitDmd] 1)]);
 39.1044 +qed_goalw "LatticeReflexivity" TLA.thy [leadsto_def] "|- F ~> F"
 39.1045 +   (fn _ => [REPEAT (resolve_tac [necT,InitDmd_gen] 1)]);
 39.1046  
 39.1047 -qed_goalw "LatticeTransitivity" TLA.thy [leadsto]
 39.1048 -   "!!sigma. [| (sigma |= G ~> H); (sigma |= F ~> G) |] ==> (sigma |= F ~> H)"
 39.1049 -   (fn _ => [etac dup_boxE 1,  (* [][](Init G .-> H) *)
 39.1050 +qed_goalw "LatticeTransitivity" TLA.thy [leadsto_def]
 39.1051 +   "|- (G ~> H) & (F ~> G) --> (F ~> H)"
 39.1052 +   (fn _ => [Clarsimp_tac 1,
 39.1053 +             etac dup_boxE 1,  (* [][](Init G --> H) *)
 39.1054  	     merge_box_tac 1,
 39.1055 -	     auto_tac (temp_css addSEs2 [STL4E]),
 39.1056 -	     rewtac (temp_rewrite DmdAct),
 39.1057 -	     subgoal_tac "sigmaa |= <><> Init H" 1,
 39.1058 -	     asm_full_simp_tac (simpset() addsimps more_temp_simps) 1,
 39.1059 -	     fast_tac (temp_cs addSEs [DmdImpl2]) 1
 39.1060 +	     clarsimp_tac (temp_css addSEs2 [STL4E]) 1,
 39.1061 +             rtac dup_dmdD 1,
 39.1062 +             subgoal_tac "sigmaa |= <>Init G" 1,
 39.1063 +             etac DmdImpl2 1, atac 1,
 39.1064 +             asm_simp_tac (simpset() addsimps [dmdInitD]) 1
 39.1065  	    ]);
 39.1066  
 39.1067 -qed_goalw "LatticeDisjunctionElim1" TLA.thy [leadsto]
 39.1068 -   "!!sigma. (sigma |= (F .| G) ~> H) ==> (sigma |= F ~> H)"
 39.1069 -   (fn _ => [ auto_tac (temp_css addsimps2 [Init_def] addSEs2 [STL4E]) ]);
 39.1070 +qed_goalw "LatticeDisjunctionElim1" TLA.thy [leadsto_def]
 39.1071 +   "|- (F | G ~> H) --> (F ~> H)"
 39.1072 +   (fn _ => [ auto_tac (temp_css addsimps2 Init_simps addSEs2 [STL4E]) ]);
 39.1073  
 39.1074 -qed_goalw "LatticeDisjunctionElim2" TLA.thy [leadsto]
 39.1075 -   "!!sigma. (sigma |= (F .| G) ~> H) ==> (sigma |= G ~> H)"
 39.1076 -   (fn _ => [ auto_tac (temp_css addsimps2 [Init_def] addSEs2 [STL4E]) ]);
 39.1077 +qed_goalw "LatticeDisjunctionElim2" TLA.thy [leadsto_def]
 39.1078 +   "|- (F | G ~> H) --> (G ~> H)"
 39.1079 +   (fn _ => [ auto_tac (temp_css addsimps2 Init_simps addSEs2 [STL4E]) ]);
 39.1080  
 39.1081 -qed_goalw "LatticeDisjunctionIntro" TLA.thy [leadsto]
 39.1082 -   "!!sigma. [| (sigma |= F ~> H); (sigma |= G ~> H) |] ==> (sigma |= (F .| G) ~> H)"
 39.1083 -   (fn _ => [merge_box_tac 1,
 39.1084 -	     auto_tac (temp_css addsimps2 [Init_def] addSEs2 [STL4E])
 39.1085 +qed_goalw "LatticeDisjunctionIntro" TLA.thy [leadsto_def]
 39.1086 +   "|- (F ~> H) & (G ~> H) --> (F | G ~> H)"
 39.1087 +   (fn _ => [Clarsimp_tac 1,
 39.1088 +             merge_box_tac 1,
 39.1089 +	     auto_tac (temp_css addsimps2 Init_simps addSEs2 [STL4E])
 39.1090  	    ]);
 39.1091  
 39.1092 +qed_goal "LatticeDisjunction" TLA.thy
 39.1093 +   "|- (F | G ~> H) = ((F ~> H) & (G ~> H))"
 39.1094 +   (fn _ => [auto_tac (temp_css addIs2 [LatticeDisjunctionIntro,
 39.1095 +                                LatticeDisjunctionElim1, LatticeDisjunctionElim2])]);
 39.1096 +
 39.1097  qed_goal "LatticeDiamond" TLA.thy
 39.1098 -   "!!sigma. [| (sigma |= B ~> D); (sigma |= A ~> (B .| C)); (sigma |= C ~> D) |]  \
 39.1099 -\            ==> (sigma |= A ~> D)"
 39.1100 -   (fn _ => [subgoal_tac "sigma |= (B .| C) ~> D" 1,
 39.1101 -	     eres_inst_tac [("G", "B .| C")] LatticeTransitivity 1,
 39.1102 +   "|- (A ~> B | C) & (B ~> D) & (C ~> D) --> (A ~> D)"
 39.1103 +   (fn _ => [Clarsimp_tac 1,
 39.1104 +             subgoal_tac "sigma |= (B | C) ~> D" 1,
 39.1105 +	     eres_inst_tac [("G", "LIFT (B | C)")] (temp_use LatticeTransitivity) 1,
 39.1106  	     ALLGOALS (fast_tac (temp_cs addSIs [LatticeDisjunctionIntro]))
 39.1107  	    ]);
 39.1108  
 39.1109  qed_goal "LatticeTriangle" TLA.thy
 39.1110 -   "!!sigma. [| (sigma |= B ~> D); (sigma |= A ~> (B .| D)) |] ==> (sigma |= A ~> D)"
 39.1111 -   (fn _ => [subgoal_tac "sigma |= (B .| D) ~> D" 1,
 39.1112 -	     eres_inst_tac [("G", "B .| D")] LatticeTransitivity 1, atac 1,
 39.1113 -	     auto_tac (temp_css addSIs2 [LatticeDisjunctionIntro] addIs2 [ImplLeadsto])
 39.1114 +   "|- (A ~> D | B) & (B ~> D) --> (A ~> D)"
 39.1115 +   (fn _ => [Clarsimp_tac 1,
 39.1116 +             subgoal_tac "sigma |= (D | B) ~> D" 1,
 39.1117 +	     eres_inst_tac [("G", "LIFT (D | B)")] (temp_use LatticeTransitivity) 1, atac 1,
 39.1118 +	     auto_tac (temp_css addSIs2 [LatticeDisjunctionIntro] 
 39.1119 +                                addIs2 [LatticeReflexivity])
 39.1120 +	    ]);
 39.1121 +
 39.1122 +qed_goal "LatticeTriangle2" TLA.thy
 39.1123 +   "|- (A ~> B | D) & (B ~> D) --> (A ~> D)"
 39.1124 +   (fn _ => [Clarsimp_tac 1,
 39.1125 +             subgoal_tac "sigma |= B | D ~> D" 1,
 39.1126 +	     eres_inst_tac [("G", "LIFT (B | D)")] (temp_use LatticeTransitivity) 1, atac 1,
 39.1127 +	     auto_tac (temp_css addSIs2 [LatticeDisjunctionIntro] 
 39.1128 +                                addIs2 [LatticeReflexivity])
 39.1129  	    ]);