src/HOL/UNITY/Project.ML
changeset 7689 affe0c2fdfbf
parent 7660 7e38237edfcb
child 7826 c6a8b73b6c2a
equal deleted inserted replaced
7688:d106cad8f515 7689:affe0c2fdfbf
    16 by (auto_tac (claset(), simpset() addsimps [project_act_def]));
    16 by (auto_tac (claset(), simpset() addsimps [project_act_def]));
    17 qed "project_act_mono";
    17 qed "project_act_mono";
    18 
    18 
    19 Goal "[| D <= C; project C h F : A co B |] ==> project D h F : A co B";
    19 Goal "[| D <= C; project C h F : A co B |] ==> project D h F : A co B";
    20 by (auto_tac (claset(), simpset() addsimps [constrains_def]));
    20 by (auto_tac (claset(), simpset() addsimps [constrains_def]));
    21 bd project_act_mono 1;
    21 by (dtac project_act_mono 1);
    22 by (Blast_tac 1);
    22 by (Blast_tac 1);
    23 qed "project_constrains_mono";
    23 qed "project_constrains_mono";
    24 
    24 
    25 Goal "[| D <= C;  project C h F : stable A |] ==> project D h F : stable A";
    25 Goal "[| D <= C;  project C h F : stable A |] ==> project D h F : stable A";
    26 by (asm_full_simp_tac
    26 by (asm_full_simp_tac
    63      "(project UNIV h F : stable A) = (F : stable (extend_set h A))";
    63      "(project UNIV h F : stable A) = (F : stable (extend_set h A))";
    64 by (simp_tac (simpset() addsimps [project_constrains]) 1);
    64 by (simp_tac (simpset() addsimps [project_constrains]) 1);
    65 qed "project_stable";
    65 qed "project_stable";
    66 
    66 
    67 Goal "F : stable (extend_set h A) ==> project C h F : stable A";
    67 Goal "F : stable (extend_set h A) ==> project C h F : stable A";
    68 bd (project_stable RS iffD2) 1;
    68 by (dtac (project_stable RS iffD2) 1);
    69 by (blast_tac (claset() addIs [project_stable_mono]) 1);
    69 by (blast_tac (claset() addIs [project_stable_mono]) 1);
    70 qed "project_stable_I";
    70 qed "project_stable_I";
    71 
    71 
    72 (*used below to prove Join_project_ensures*)
    72 (*used below to prove Join_project_ensures*)
    73 Goal "[| G : stable C;  project C h G : A unless B |] \
    73 Goal "[| G : stable C;  project C h G : A unless B |] \
   104 by (auto_tac (claset(),
   104 by (auto_tac (claset(),
   105 	      simpset() addsimps [Join_stable, Collect_eq_extend_set RS sym,
   105 	      simpset() addsimps [Join_stable, Collect_eq_extend_set RS sym,
   106 				  extend_stable RS iffD1]));
   106 				  extend_stable RS iffD1]));
   107 qed "Join_project_increasing";
   107 qed "Join_project_increasing";
   108 
   108 
       
   109 (*For using project_guarantees in particular cases*)
       
   110 Goal "extend h F Join G : extend_set h A co extend_set h B \
       
   111 \     ==> F Join project UNIV h G : A co B";
       
   112 by (stac (project_set_UNIV RS project_extend_Join RS sym) 1);
       
   113 by (asm_full_simp_tac
       
   114     (simpset() addsimps [project_constrains, Join_constrains, 
       
   115 			 extend_constrains]) 1);
       
   116 by (fast_tac (claset() addDs [constrains_imp_subset]) 1);
       
   117 qed "project_constrains_I";
       
   118 
   109 
   119 
   110 (*** Diff, needed for localTo ***)
   120 (*** Diff, needed for localTo ***)
   111 
   121 
   112 (*Opposite direction fails because Diff in the extended state may remove
   122 (*Opposite direction fails because Diff in the extended state may remove
   113   fewer actions, i.e. those that affect other state variables.*)
   123   fewer actions, i.e. those that affect other state variables.*)
   138 by (etac Diff_project_co 1);
   148 by (etac Diff_project_co 1);
   139 by (assume_tac 1);
   149 by (assume_tac 1);
   140 qed "Diff_project_stable";
   150 qed "Diff_project_stable";
   141 
   151 
   142 (*Converse appears to fail*)
   152 (*Converse appears to fail*)
   143 Goal "[| UNIV <= project_set h C;  (H : (func o f) localTo extend h G) |] \
   153 Goal "[| UNIV <= project_set h C;  H : (func o f) localTo extend h G |] \
   144 \     ==> (project C h H : func localTo G)";
   154 \     ==> project C h H : func localTo G";
   145 by (asm_full_simp_tac 
   155 by (asm_full_simp_tac 
   146     (simpset() addsimps [localTo_def, 
   156     (simpset() addsimps [localTo_def, 
   147 			 project_extend_Join RS sym,
   157 			 project_extend_Join RS sym,
   148 			 subset_UNIV RS subset_trans RS Diff_project_stable,
   158 			 subset_UNIV RS subset_trans RS Diff_project_stable,
   149 			 Collect_eq_extend_set RS sym]) 1);
   159 			 Collect_eq_extend_set RS sym]) 1);
       
   160 qed "project_localTo_lemma";
       
   161 
       
   162 Goal "extend h F Join G : (v o f) localTo extend h H \
       
   163 \     ==> F Join project UNIV h G : v localTo H";
       
   164 by (stac (project_set_UNIV RS project_extend_Join RS sym) 1);
       
   165 by (asm_simp_tac 
       
   166     (simpset() addsimps [project_set_UNIV RS project_localTo_lemma]) 1);
   150 qed "project_localTo_I";
   167 qed "project_localTo_I";
   151 
   168 
   152 
   169 
   153 (** Reachability and project **)
   170 (** Reachability and project **)
   154 
   171 
   164 by (res_inst_tac [("act","x")] reachable.Acts 1);
   181 by (res_inst_tac [("act","x")] reachable.Acts 1);
   165 by Auto_tac;
   182 by Auto_tac;
   166 by (etac extend_act_D 1);
   183 by (etac extend_act_D 1);
   167 qed "reachable_imp_reachable_project";
   184 qed "reachable_imp_reachable_project";
   168 
   185 
       
   186 (*The extra generality in the first premise allows guarantees with STRONG
       
   187   preconditions (localTo) and WEAK postconditions.*)
   169 Goalw [Constrains_def]
   188 Goalw [Constrains_def]
   170      "[| reachable (extend h F Join G) <= C;    \
   189      "[| reachable (extend h F Join G) <= C;    \
   171 \        F Join project C h G : A Co B |] \
   190 \        F Join project C h G : A Co B |] \
   172 \     ==> extend h F Join G : (extend_set h A) Co (extend_set h B)";
   191 \     ==> extend h F Join G : (extend_set h A) Co (extend_set h B)";
   173 by (full_simp_tac (simpset() addsimps [Join_project_constrains]) 1);
   192 by (full_simp_tac (simpset() addsimps [Join_project_constrains]) 1);
   186 Goalw [Always_def]
   205 Goalw [Always_def]
   187      "[| reachable (extend h F Join G) <= C;  \
   206      "[| reachable (extend h F Join G) <= C;  \
   188 \        F Join project C h G : Always A |]   \
   207 \        F Join project C h G : Always A |]   \
   189 \     ==> extend h F Join G : Always (extend_set h A)";
   208 \     ==> extend h F Join G : Always (extend_set h A)";
   190 by (force_tac (claset() addIs [reachable.Init, project_set_I],
   209 by (force_tac (claset() addIs [reachable.Init, project_set_I],
   191 	       simpset() addsimps [project_Stable_D]) 1);
   210                simpset() addsimps [project_Stable_D]) 1);
   192 qed "project_Always_D";
   211 qed "project_Always_D";
   193 
   212 
   194 Goalw [Increasing_def]
   213 Goalw [Increasing_def]
   195      "[| reachable (extend h F Join G) <= C;  \
   214      "[| reachable (extend h F Join G) <= C;  \
   196 \        F Join project C h G : Increasing func |] \
   215 \        F Join project C h G : Increasing func |] \
   247      "[| C <= reachable (extend h F Join G);  \
   266      "[| C <= reachable (extend h F Join G);  \
   248 \        extend h F Join G : Stable (extend_set h A) |] \
   267 \        extend h F Join G : Stable (extend_set h A) |] \
   249 \     ==> F Join project C h G : Stable A";
   268 \     ==> F Join project C h G : Stable A";
   250 by (asm_simp_tac (simpset() addsimps [project_Constrains_I]) 1);
   269 by (asm_simp_tac (simpset() addsimps [project_Constrains_I]) 1);
   251 qed "project_Stable_I";
   270 qed "project_Stable_I";
       
   271 
       
   272 Goalw [Always_def]
       
   273      "[| C <= reachable (extend h F Join G);  \
       
   274 \        extend h F Join G : Always (extend_set h A) |]   \
       
   275 \     ==> F Join project C h G : Always A";
       
   276 by (auto_tac (claset(), simpset() addsimps [project_Stable_I]));
       
   277 bws [project_set_def, extend_set_def];
       
   278 by (Blast_tac 1);
       
   279 qed "project_Always_I";
   252 
   280 
   253 Goalw [Increasing_def]
   281 Goalw [Increasing_def]
   254      "[| C <= reachable (extend h F Join G);  \
   282      "[| C <= reachable (extend h F Join G);  \
   255 \        extend h F Join G : Increasing (func o f) |] \
   283 \        extend h F Join G : Increasing (func o f) |] \
   256 \     ==> F Join project C h G : Increasing func";
   284 \     ==> F Join project C h G : Increasing func";
   367 by (asm_simp_tac (simpset() delsimps UN_simps
   395 by (asm_simp_tac (simpset() delsimps UN_simps
   368 		  addsimps [Int_UN_distrib, leadsTo_UN, extend_set_Union]) 3);
   396 		  addsimps [Int_UN_distrib, leadsTo_UN, extend_set_Union]) 3);
   369 by (blast_tac (claset() addIs [psp_stable RS leadsTo_weaken, 
   397 by (blast_tac (claset() addIs [psp_stable RS leadsTo_weaken, 
   370 			       leadsTo_Trans]) 2);
   398 			       leadsTo_Trans]) 2);
   371 by (blast_tac (claset() addIs [leadsTo_Basis, Join_project_ensures]) 1);
   399 by (blast_tac (claset() addIs [leadsTo_Basis, Join_project_ensures]) 1);
   372 qed "Join_project_leadsTo_I";
   400 qed "project_leadsTo_lemma";
   373 
   401 
   374 (*Instance of the previous theorem for STRONG progress*)
   402 (*Instance of the previous theorem for STRONG progress*)
   375 Goal "[| ALL x. project UNIV h G ~: transient {x};  \
   403 Goal "[| ALL x. project UNIV h G ~: transient {x};  \
   376 \        F Join project UNIV h G : A leadsTo B |] \
   404 \        F Join project UNIV h G : A leadsTo B |] \
   377 \     ==> extend h F Join G : (extend_set h A) leadsTo (extend_set h B)";
   405 \     ==> extend h F Join G : (extend_set h A) leadsTo (extend_set h B)";
   378 by (dtac Join_project_leadsTo_I 1);
   406 by (dtac project_leadsTo_lemma 1);
   379 by Auto_tac;
   407 by Auto_tac;
   380 qed "Join_project_UNIV_leadsTo_I";
   408 qed "project_UNIV_leadsTo_lemma";
   381 
   409 
   382 (** Towards the analogous theorem for WEAK progress*)
   410 (** Towards the analogous theorem for WEAK progress*)
   383 
   411 
   384 Goal "[| ALL x. project C h G ~: transient {x};  \
   412 Goal "[| ALL x. project C h G ~: transient {x};  \
   385 \        extend h F Join G : stable C;  \
   413 \        extend h F Join G : stable C;  \
   395 
   423 
   396 Goal "[| ALL x. project C h G ~: transient {x};  \
   424 Goal "[| ALL x. project C h G ~: transient {x};  \
   397 \        extend h F Join G : stable C;  \
   425 \        extend h F Join G : stable C;  \
   398 \        F Join project C h G : (project_set h C Int A) leadsTo B |] \
   426 \        F Join project C h G : (project_set h C Int A) leadsTo B |] \
   399 \     ==> extend h F Join G : (C Int extend_set h A) leadsTo (extend_set h B)";
   427 \     ==> extend h F Join G : (C Int extend_set h A) leadsTo (extend_set h B)";
   400 br (lemma RS leadsTo_weaken) 1;
   428 by (rtac (lemma RS leadsTo_weaken) 1);
   401 by (auto_tac (claset() addIs [project_set_I], simpset()));
   429 by (auto_tac (claset() addIs [project_set_I], simpset()));
   402 val lemma2 = result();
   430 val lemma2 = result();
   403 
   431 
   404 Goal "[| C = (reachable (extend h F Join G)); \
   432 Goal "[| C = (reachable (extend h F Join G)); \
   405 \        ALL x. project C h G ~: transient {x};  \
   433 \        ALL x. project C h G ~: transient {x};  \
   473 by (etac project_guarantees 1);
   501 by (etac project_guarantees 1);
   474 by (rtac (subset_UNIV RS project_Increasing_D) 2);
   502 by (rtac (subset_UNIV RS project_Increasing_D) 2);
   475 by Auto_tac;
   503 by Auto_tac;
   476 qed "extend_guar_Increasing";
   504 qed "extend_guar_Increasing";
   477 
   505 
   478 Goal "F : (func localTo G) guarantees increasing func  \
   506 Goal "F : (v localTo G) guarantees increasing func  \
   479 \     ==> extend h F : (func o f) localTo (extend h G)  \
   507 \     ==> extend h F : (v o f) localTo (extend h G)  \
   480 \                      guarantees increasing (func o f)";
   508 \                      guarantees increasing (func o f)";
   481 by (etac project_guarantees 1);
   509 by (etac project_guarantees 1);
   482 (*the "increasing" guarantee*)
   510 (*the "increasing" guarantee*)
   483 by (asm_simp_tac
   511 by (asm_simp_tac (simpset() addsimps [Join_project_increasing RS sym]) 2);
   484     (simpset() addsimps [Join_project_increasing RS sym]) 2);
   512 by (etac project_localTo_I 1);
   485 (*the "localTo" requirement*)
       
   486 by (stac (project_set_UNIV RS project_extend_Join RS sym) 1);
       
   487 by (asm_simp_tac 
       
   488     (simpset() addsimps [project_set_UNIV RS project_localTo_I]) 1);
       
   489 qed "extend_localTo_guar_increasing";
   513 qed "extend_localTo_guar_increasing";
   490 
   514 
   491 Goal "F : (func localTo G) guarantees Increasing func  \
   515 Goal "F : (v localTo G) guarantees Increasing func  \
   492 \     ==> extend h F : (func o f) localTo (extend h G)  \
   516 \     ==> extend h F : (v o f) localTo (extend h G)  \
   493 \                      guarantees Increasing (func o f)";
   517 \                      guarantees Increasing (func o f)";
   494 by (etac project_guarantees 1);
   518 by (etac project_guarantees 1);
   495 (*the "Increasing" guarantee*)
   519 (*the "Increasing" guarantee*)
   496 by (etac (subset_UNIV RS project_Increasing_D) 2);
   520 by (etac (subset_UNIV RS project_Increasing_D) 2);
   497 (*the "localTo" requirement*)
   521 by (etac project_localTo_I 1);
   498 by (stac (project_set_UNIV RS project_extend_Join RS sym) 1);
       
   499 by (asm_simp_tac 
       
   500     (simpset() addsimps [project_set_UNIV RS project_localTo_I]) 1);
       
   501 qed "extend_localTo_guar_Increasing";
   522 qed "extend_localTo_guar_Increasing";
       
   523 
       
   524 Goal "F : Always A guarantees Always B \
       
   525 \ ==> extend h F : Always(extend_set h A) guarantees Always(extend_set h B)";
       
   526 by (etac project_guarantees 1);
       
   527 by (etac (subset_refl RS project_Always_D) 2);
       
   528 by (etac (subset_refl RS project_Always_I) 1);
       
   529 qed "extend_guar_Always";
   502 
   530 
   503 
   531 
   504 (** Guarantees with a leadsTo postcondition **)
   532 (** Guarantees with a leadsTo postcondition **)
   505 
   533 
   506 Goal "[| G : f localTo extend h F; \
   534 Goal "[| G : f localTo extend h F; \
   507 \        Disjoint (extend h F) G |] ==> project C h G : stable {x}";
   535 \        Disjoint (extend h F) G |] ==> project C h G : stable {x}";
   508 by (asm_full_simp_tac
   536 by (asm_full_simp_tac
   509     (simpset() addsimps [localTo_imp_stable,
   537     (simpset() addsimps [localTo_imp_stable,
   510 			 extend_set_sing, project_stable_I]) 1);
   538 			 extend_set_sing, project_stable_I]) 1);
   511 qed "localTo_imp_project_stable";
   539 qed "localTo_imp_project_stable";
   512 
       
   513 
   540 
   514 Goal "F : stable{s} ==> F ~: transient {s}";
   541 Goal "F : stable{s} ==> F ~: transient {s}";
   515 by (auto_tac (claset(), 
   542 by (auto_tac (claset(), 
   516 	      simpset() addsimps [FP_def, transient_def,
   543 	      simpset() addsimps [FP_def, transient_def,
   517 				  stable_def, constrains_def]));
   544 				  stable_def, constrains_def]));
   518 qed "stable_sing_imp_not_transient";
   545 qed "stable_sing_imp_not_transient";
   519 
   546 
       
   547 Goal "[| F Join project UNIV h G : A leadsTo B;    \
       
   548 \        extend h F Join G : f localTo extend h F; \
       
   549 \        Disjoint (extend h F) G |]  \
       
   550 \     ==> extend h F Join G : (extend_set h A) leadsTo (extend_set h B)";
       
   551 by (rtac project_UNIV_leadsTo_lemma 1);
       
   552 by Auto_tac;
       
   553 by (asm_full_simp_tac
       
   554     (simpset() addsimps [Join_localTo, self_localTo,
       
   555 			 localTo_imp_project_stable, 
       
   556 			 stable_sing_imp_not_transient]) 1);
       
   557 qed "project_leadsTo_D";
       
   558 
       
   559 
       
   560 Goal "[| F Join project (reachable (extend h F Join G)) h G : A LeadsTo B; \
       
   561 \         extend h F Join G : f localTo extend h F; \
       
   562 \         Disjoint (extend h F) G  |]  \
       
   563 \      ==> extend h F Join G : (extend_set h A) LeadsTo (extend_set h B)";
       
   564 by (rtac Join_project_LeadsTo 1);
       
   565 by Auto_tac;
       
   566 by (asm_full_simp_tac
       
   567     (simpset() addsimps [Join_localTo, self_localTo,
       
   568 			 localTo_imp_project_stable, 
       
   569 			 stable_sing_imp_not_transient]) 1);
       
   570 qed "project_LeadsTo_D";
       
   571 
       
   572 
   520 (*STRONG precondition and postcondition*)
   573 (*STRONG precondition and postcondition*)
   521 Goal "F : (A co A') guarantees (B leadsTo B')  \
   574 Goal "F : (A co A') guarantees (B leadsTo B')  \
   522 \ ==> extend h F : ((extend_set h A) co (extend_set h A'))  \
   575 \ ==> extend h F : ((extend_set h A) co (extend_set h A'))  \
   523 \                   Int (f localTo (extend h F)) \
   576 \                   Int (f localTo (extend h F)) \
   524 \                  guarantees ((extend_set h B) leadsTo (extend_set h B'))";
   577 \                  guarantees ((extend_set h B) leadsTo (extend_set h B'))";
   525 by (etac project_guarantees 1);
   578 by (etac project_guarantees 1);
   526 (*the safety precondition*)
   579 (*the safety precondition*)
   527 by (stac (project_set_UNIV RS project_extend_Join RS sym) 1);
   580 by (fast_tac (claset() addIs [project_constrains_I]) 1);
   528 by (asm_full_simp_tac
       
   529     (simpset() addsimps [project_constrains, Join_constrains, 
       
   530 			 extend_constrains]) 1);
       
   531 by (fast_tac (claset() addDs [constrains_imp_subset]) 1);
       
   532 (*the liveness postcondition*)
   581 (*the liveness postcondition*)
   533 by (rtac Join_project_UNIV_leadsTo_I 1);
   582 by (fast_tac (claset() addIs [project_leadsTo_D]) 1);
   534 by Auto_tac;
       
   535 by (asm_full_simp_tac
       
   536     (simpset() addsimps [Join_localTo, self_localTo,
       
   537 			 localTo_imp_project_stable, 
       
   538 			 stable_sing_imp_not_transient]) 1);
       
   539 qed "extend_co_guar_leadsTo";
   583 qed "extend_co_guar_leadsTo";
   540 
   584 
   541 (*WEAK precondition and postcondition*)
   585 (*WEAK precondition and postcondition*)
   542 Goal "F : (A Co A') guarantees (B LeadsTo B')  \
   586 Goal "F : (A Co A') guarantees (B LeadsTo B')  \
   543 \ ==> extend h F : ((extend_set h A) Co (extend_set h A'))  \
   587 \ ==> extend h F : ((extend_set h A) Co (extend_set h A'))  \
   545 \                  guarantees ((extend_set h B) LeadsTo (extend_set h B'))";
   589 \                  guarantees ((extend_set h B) LeadsTo (extend_set h B'))";
   546 by (etac project_guarantees 1);
   590 by (etac project_guarantees 1);
   547 (*the safety precondition*)
   591 (*the safety precondition*)
   548 by (fast_tac (claset() addIs [project_Constrains_I]) 1);
   592 by (fast_tac (claset() addIs [project_Constrains_I]) 1);
   549 (*the liveness postcondition*)
   593 (*the liveness postcondition*)
   550 by (rtac Join_project_LeadsTo 1);
   594 by (fast_tac (claset() addIs [project_LeadsTo_D]) 1);
   551 by Auto_tac;
       
   552 by (asm_full_simp_tac
       
   553     (simpset() addsimps [Join_localTo, self_localTo,
       
   554 			 localTo_imp_project_stable, 
       
   555 			 stable_sing_imp_not_transient]) 1);
       
   556 qed "extend_Co_guar_LeadsTo";
   595 qed "extend_Co_guar_LeadsTo";
   557 
   596 
   558 
       
   559 Close_locale "Extend";
   597 Close_locale "Extend";