now trans_tac is part of the claset...
authorpaulson
Fri, 14 Aug 1998 13:52:42 +0200
changeset 532079b326bceafb
parent 5319 7356d0c88b1b
child 5321 f8848433d240
now trans_tac is part of the claset...
src/HOL/UNITY/Handshake.ML
src/HOL/UNITY/LessThan.ML
src/HOL/UNITY/Lift.ML
src/HOL/UNITY/Lift.thy
src/HOL/UNITY/Mutex.ML
     1.1 --- a/src/HOL/UNITY/Handshake.ML	Fri Aug 14 12:06:34 1998 +0200
     1.2 +++ b/src/HOL/UNITY/Handshake.ML	Fri Aug 14 13:52:42 1998 +0200
     1.3 @@ -50,7 +50,6 @@
     1.4  by (res_inst_tac [("f", "NF"), ("l","Suc m"), ("B","{}")] 
     1.5      GreaterThan_bounded_induct 1);
     1.6  by (auto_tac (claset(), simpset() addsimps [vimage_def]));
     1.7 -by (trans_tac 2);
     1.8  (*The inductive step: LeadsTo (Join prgF prgG) {x. NF x = ma} {x. ma < NF x}*)
     1.9  by (rtac LeadsTo_Diff 1);
    1.10  by (rtac lemma2_2 2);
     2.1 --- a/src/HOL/UNITY/LessThan.ML	Fri Aug 14 12:06:34 1998 +0200
     2.2 +++ b/src/HOL/UNITY/LessThan.ML	Fri Aug 14 13:52:42 1998 +0200
     2.3 @@ -7,6 +7,9 @@
     2.4  *)
     2.5  
     2.6  
     2.7 +claset_ref() := claset() addaltern ("trans_tac",trans_tac);
     2.8 +
     2.9 +
    2.10  (*** lessThan ***)
    2.11  
    2.12  Goalw [lessThan_def] "(i: lessThan k) = (i<k)";
     3.1 --- a/src/HOL/UNITY/Lift.ML	Fri Aug 14 12:06:34 1998 +0200
     3.2 +++ b/src/HOL/UNITY/Lift.ML	Fri Aug 14 13:52:42 1998 +0200
     3.3 @@ -33,10 +33,18 @@
     3.4  	  moving_up_def, moving_down_def];
     3.5  
     3.6  
     3.7 +val nat_exhaust_less_pred = 
     3.8 +    read_instantiate_sg (sign_of thy) [("P", "?m < ?y-1")] nat.exhaust;
     3.9 +
    3.10 +val nat_exhaust_le_pred = 
    3.11 +    read_instantiate_sg (sign_of thy) [("P", "?m <= ?y-1")] nat.exhaust;
    3.12 +
    3.13 +val nat_exhaust_pred_le = 
    3.14 +    read_instantiate_sg (sign_of thy) [("P", "?y-1 <= ?m")] nat.exhaust;
    3.15 +
    3.16  Goal "0 < n ==> (m <= n-1) = (m<n)";
    3.17  by (exhaust_tac "n" 1);
    3.18  by Auto_tac;
    3.19 -by (REPEAT_FIRST trans_tac);
    3.20  qed "le_pred_eq";
    3.21  
    3.22  Goal "m < n ==> m <= n-1";
    3.23 @@ -82,57 +90,44 @@
    3.24  qed "moving_down";
    3.25  
    3.26  
    3.27 -xxxxxxxxxxxxxxxx;
    3.28 -
    3.29 -Goalw [Lprg_def] "Invariant Lprg bounded";
    3.30 +Goal "Invariant Lprg bounded";
    3.31  by (rtac InvariantI 1);
    3.32 +br (Invariant_Int_rule [moving_up, moving_down] RS Invariant_StableI) 2;
    3.33 +bw Lprg_def;
    3.34  by (Force_tac 1);
    3.35  by (constrains_tac (cmd_defs@always_defs) 1);
    3.36 -by (ALLGOALS
    3.37 -    (asm_simp_tac (simpset() addsimps [gr_implies_gr0 RS le_pred_eq])));
    3.38 -by (REPEAT_FIRST trans_tac);
    3.39 -by (blast_tac (claset() addIs [diff_le_self, le_trans]) 1);
    3.40 -by (blast_tac (claset() addIs [diff_le_self, le_trans]) 1);
    3.41 -by (blast_tac (claset() addIs [diff_le_self, le_trans]) 3);
    3.42 +by (TRYALL (resolve_tac [nat_exhaust_le_pred, nat_exhaust_pred_le]));
    3.43 +by (auto_tac (claset(), simpset() addsimps [less_Suc_eq]));
    3.44 +by (auto_tac (claset(), simpset() addsimps [less_Suc_eq, le_eq_less_or_eq]));
    3.45  qed "bounded";
    3.46  
    3.47 -Goalw [Lprg_def] "Invariant Lprg invariantV";
    3.48 -by (rtac InvariantI 1);
    3.49 -by (constrains_tac cmd_defs 2);
    3.50 -by Auto_tac;
    3.51 -qed "invariantV";
    3.52  
    3.53 -val invariantUV = invariant_Int_rule [invariantU, invariantV];
    3.54  
    3.55 +(*** Progress ***)
    3.56  
    3.57 -(*The safety property: mutual exclusion*)
    3.58 -Goal "(reachable Lprg) Int {s. MM s = 3 & NN s = 3} = {}";
    3.59 -by (cut_facts_tac [invariantUV RS invariant_includes_reachable] 1);
    3.60 -by Auto_tac;
    3.61 -qed "mutual_exclusion";
    3.62  
    3.63 +val abbrev_defs = [moving_def, stopped_def, 
    3.64 +		   opened_def, closed_def, atFloor_def];
    3.65  
    3.66 -(*** Progress for U ***)
    3.67 +val defs = cmd_defs@always_defs@abbrev_defs;
    3.68  
    3.69 -Goalw [unless_def] "unless (Acts Lprg) {s. MM s=2} {s. MM s=3}";
    3.70 -by (constrains_tac cmd_defs 1);
    3.71 -qed "U_F0";
    3.72 +(***
    3.73  
    3.74 -Goal "LeadsTo Lprg {s. MM s=1} {s. PP s = VV s & MM s = 2}";
    3.75 -by (ensures_tac cmd_defs "cmd1U" 1);
    3.76 +Goal "LeadsTo Lprg (stopped Int atFloor n) (opened Int atFloor n)";
    3.77 +by (ensures_tac defs "open_act" 1);
    3.78  qed "U_F1";
    3.79  
    3.80  Goal "LeadsTo Lprg {s. ~ PP s & MM s = 2} {s. MM s = 3}";
    3.81  by (cut_facts_tac [invariantUV] 1);
    3.82  by (rewtac Lprg_def);
    3.83 -by (ensures_tac cmd_defs "cmd2U" 1);
    3.84 +by (ensures_tac defs "cmd2U" 1);
    3.85  qed "U_F2";
    3.86  
    3.87  Goal "LeadsTo Lprg {s. MM s = 3} {s. PP s}";
    3.88  by (rtac leadsTo_imp_LeadsTo 1); 
    3.89  by (res_inst_tac [("B", "{s. MM s = 4}")] leadsTo_Trans 1);
    3.90 -by (ensures_tac cmd_defs "cmd4U" 2);
    3.91 -by (ensures_tac cmd_defs "cmd3U" 1);
    3.92 +by (ensures_tac defs "cmd4U" 2);
    3.93 +by (ensures_tac defs "cmd3U" 1);
    3.94  qed "U_F3";
    3.95  
    3.96  Goal "LeadsTo Lprg {s. MM s = 2} {s. PP s}";
    3.97 @@ -142,3 +137,4 @@
    3.98  by (auto_tac (claset() addSEs [less_SucE], simpset()));
    3.99  val U_lemma2 = result();
   3.100  
   3.101 +***)
     4.1 --- a/src/HOL/UNITY/Lift.thy	Fri Aug 14 12:06:34 1998 +0200
     4.2 +++ b/src/HOL/UNITY/Lift.thy	Fri Aug 14 13:52:42 1998 +0200
     4.3 @@ -27,25 +27,44 @@
     4.4    
     4.5    (** Abbreviations: the "always" part **)
     4.6    
     4.7 -  above :: "state set"
     4.8 +  above :: state set
     4.9      "above == {s. EX i. floor s < i & i <= max & i : req s}"
    4.10  
    4.11 -  below :: "state set"
    4.12 +  below :: state set
    4.13      "below == {s. EX i. min <= i & i < floor s & i : req s}"
    4.14  
    4.15 -  queueing :: "state set"
    4.16 +  queueing :: state set
    4.17      "queueing == above Un below"
    4.18  
    4.19 -  goingup :: "state set"
    4.20 +  goingup :: state set
    4.21      "goingup == above Int ({s. up s} Un Compl below)"
    4.22  
    4.23 -  goingdown :: "state set"
    4.24 +  goingdown :: state set
    4.25      "goingdown == below Int ({s. ~ up s} Un Compl above)"
    4.26  
    4.27 -  ready :: "state set"
    4.28 +  ready :: state set
    4.29      "ready == {s. stop s & ~ open s & move s}"
    4.30  
    4.31 + 
    4.32 +  (** Further abbreviations **)
    4.33  
    4.34 +  moving :: state set
    4.35 +    "moving ==  {s. ~ stop s & ~ open s}"
    4.36 +
    4.37 +  stopped :: state set
    4.38 +    "stopped == {s. stop s  & ~ open s &  move s}"
    4.39 +
    4.40 +  opened :: state set
    4.41 +    "opened ==  {s. stop s  &  open s  &  move s}"
    4.42 +
    4.43 +  closed :: state set
    4.44 +    "closed ==  {s. stop s  & ~ open s &  move s}"
    4.45 +
    4.46 +  atFloor :: nat => state set
    4.47 +    "atFloor n ==  {s. floor s = n}"
    4.48 +
    4.49 +
    4.50 +  
    4.51    (** The program **)
    4.52    
    4.53    request_act :: "(state*state) set"
    4.54 @@ -99,11 +118,6 @@
    4.55    bounded :: state set
    4.56      "bounded == {s. min <= floor s & floor s <= max}"
    4.57  
    4.58 -  (** ???
    4.59 -		    (~ stop s & up s --> floor s < max) &
    4.60 -		    (~ stop s & ~ up s --> min < floor s)}"
    4.61 -  **)
    4.62 -
    4.63    open_stop :: state set
    4.64      "open_stop == {s. open s --> stop s}"
    4.65    
    4.66 @@ -121,7 +135,8 @@
    4.67      "moving_down == {s. ~ stop s & ~ up s -->
    4.68                       (EX f. min <= f & f <= floor s & f : req s)}"
    4.69    
    4.70 -  valid :: "state set"
    4.71 +  (*intersection of all invariants: NECESSARY??*)
    4.72 +  valid :: state set
    4.73      "valid == bounded Int open_stop Int open_move"
    4.74  
    4.75  end
     5.1 --- a/src/HOL/UNITY/Mutex.ML	Fri Aug 14 12:06:34 1998 +0200
     5.2 +++ b/src/HOL/UNITY/Mutex.ML	Fri Aug 14 13:52:42 1998 +0200
     5.3 @@ -56,7 +56,6 @@
     5.4  by (rtac InvariantI 1);
     5.5  by (Force_tac 1);
     5.6  by (constrains_tac cmd_defs 1);
     5.7 -by (REPEAT (trans_tac 1));
     5.8  by (safe_tac (claset() addSEs [le_SucE]));
     5.9  by (Asm_full_simp_tac 1);
    5.10  (*Resulting state: n=1, p=false, m=4, u=false.