| author | immler | 
| Wed, 01 Jul 2015 13:09:56 +0200 | |
| changeset 60621 | bfb14ff43491 | 
| parent 60397 | f8a513fedb31 | 
| child 61076 | bdc1e2f0a86a | 
| permissions | -rw-r--r-- | 
| 32960 
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
 wenzelm parents: 
32689diff
changeset | 1 | (* Title: HOL/UNITY/Follows.thy | 
| 6706 | 2 | Author: Lawrence C Paulson, Cambridge University Computer Laboratory | 
| 3 | Copyright 1998 University of Cambridge | |
| 13798 | 4 | *) | 
| 6706 | 5 | |
| 58889 | 6 | section{*The Follows Relation of Charpentier and Sivilotte*}
 | 
| 6706 | 7 | |
| 41413 
64cd30d6b0b8
explicit file specifications -- avoid secondary load path;
 wenzelm parents: 
35416diff
changeset | 8 | theory Follows | 
| 
64cd30d6b0b8
explicit file specifications -- avoid secondary load path;
 wenzelm parents: 
35416diff
changeset | 9 | imports SubstAx ListOrder "~~/src/HOL/Library/Multiset" | 
| 
64cd30d6b0b8
explicit file specifications -- avoid secondary load path;
 wenzelm parents: 
35416diff
changeset | 10 | begin | 
| 6706 | 11 | |
| 35416 
d8d7d1b785af
replaced a couple of constsdefs by definitions (also some old primrecs by modern ones)
 haftmann parents: 
35274diff
changeset | 12 | definition Follows :: "['a => 'b::{order}, 'a => 'b::{order}] => 'a program set" (infixl "Fols" 65) where
 | 
| 13805 | 13 | "f Fols g == Increasing g \<inter> Increasing f Int | 
| 14 |                 Always {s. f s \<le> g s} Int
 | |
| 15 |                 (\<Inter>k. {s. k \<le> g s} LeadsTo {s. k \<le> f s})"
 | |
| 6706 | 16 | |
| 17 | ||
| 13796 | 18 | (*Does this hold for "invariant"?*) | 
| 19 | lemma mono_Always_o: | |
| 13805 | 20 |      "mono h ==> Always {s. f s \<le> g s} \<subseteq> Always {s. h (f s) \<le> h (g s)}"
 | 
| 13796 | 21 | apply (simp add: Always_eq_includes_reachable) | 
| 22 | apply (blast intro: monoD) | |
| 23 | done | |
| 24 | ||
| 25 | lemma mono_LeadsTo_o: | |
| 26 | "mono (h::'a::order => 'b::order) | |
| 13805 | 27 |       ==> (\<Inter>j. {s. j \<le> g s} LeadsTo {s. j \<le> f s}) \<subseteq>  
 | 
| 28 |           (\<Inter>k. {s. k \<le> h (g s)} LeadsTo {s. k \<le> h (f s)})"
 | |
| 13796 | 29 | apply auto | 
| 30 | apply (rule single_LeadsTo_I) | |
| 31 | apply (drule_tac x = "g s" in spec) | |
| 32 | apply (erule LeadsTo_weaken) | |
| 33 | apply (blast intro: monoD order_trans)+ | |
| 34 | done | |
| 35 | ||
| 13805 | 36 | lemma Follows_constant [iff]: "F \<in> (%s. c) Fols (%s. c)" | 
| 15102 | 37 | by (simp add: Follows_def) | 
| 13796 | 38 | |
| 13805 | 39 | lemma mono_Follows_o: "mono h ==> f Fols g \<subseteq> (h o f) Fols (h o g)" | 
| 15102 | 40 | by (auto simp add: Follows_def mono_Increasing_o [THEN [2] rev_subsetD] | 
| 32960 
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
 wenzelm parents: 
32689diff
changeset | 41 | mono_Always_o [THEN [2] rev_subsetD] | 
| 
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
 wenzelm parents: 
32689diff
changeset | 42 | mono_LeadsTo_o [THEN [2] rev_subsetD, THEN INT_D]) | 
| 13796 | 43 | |
| 44 | lemma mono_Follows_apply: | |
| 13805 | 45 | "mono h ==> f Fols g \<subseteq> (%x. h (f x)) Fols (%x. h (g x))" | 
| 13796 | 46 | apply (drule mono_Follows_o) | 
| 47 | apply (force simp add: o_def) | |
| 48 | done | |
| 49 | ||
| 50 | lemma Follows_trans: | |
| 13805 | 51 | "[| F \<in> f Fols g; F \<in> g Fols h |] ==> F \<in> f Fols h" | 
| 15102 | 52 | apply (simp add: Follows_def) | 
| 13796 | 53 | apply (simp add: Always_eq_includes_reachable) | 
| 54 | apply (blast intro: order_trans LeadsTo_Trans) | |
| 55 | done | |
| 56 | ||
| 57 | ||
| 13798 | 58 | subsection{*Destruction rules*}
 | 
| 13796 | 59 | |
| 13805 | 60 | lemma Follows_Increasing1: "F \<in> f Fols g ==> F \<in> Increasing f" | 
| 15102 | 61 | by (simp add: Follows_def) | 
| 13796 | 62 | |
| 13805 | 63 | lemma Follows_Increasing2: "F \<in> f Fols g ==> F \<in> Increasing g" | 
| 15102 | 64 | by (simp add: Follows_def) | 
| 13796 | 65 | |
| 21710 | 66 | lemma Follows_Bounded: "F \<in> f Fols g ==> F \<in> Always {s. f s \<le> g s}"
 | 
| 15102 | 67 | by (simp add: Follows_def) | 
| 13796 | 68 | |
| 69 | lemma Follows_LeadsTo: | |
| 13805 | 70 |      "F \<in> f Fols g ==> F \<in> {s. k \<le> g s} LeadsTo {s. k \<le> f s}"
 | 
| 15102 | 71 | by (simp add: Follows_def) | 
| 13796 | 72 | |
| 73 | lemma Follows_LeadsTo_pfixLe: | |
| 13805 | 74 |      "F \<in> f Fols g ==> F \<in> {s. k pfixLe g s} LeadsTo {s. k pfixLe f s}"
 | 
| 13796 | 75 | apply (rule single_LeadsTo_I, clarify) | 
| 76 | apply (drule_tac k="g s" in Follows_LeadsTo) | |
| 77 | apply (erule LeadsTo_weaken) | |
| 78 | apply blast | |
| 79 | apply (blast intro: pfixLe_trans prefix_imp_pfixLe) | |
| 80 | done | |
| 81 | ||
| 82 | lemma Follows_LeadsTo_pfixGe: | |
| 13805 | 83 |      "F \<in> f Fols g ==> F \<in> {s. k pfixGe g s} LeadsTo {s. k pfixGe f s}"
 | 
| 13796 | 84 | apply (rule single_LeadsTo_I, clarify) | 
| 85 | apply (drule_tac k="g s" in Follows_LeadsTo) | |
| 86 | apply (erule LeadsTo_weaken) | |
| 87 | apply blast | |
| 88 | apply (blast intro: pfixGe_trans prefix_imp_pfixGe) | |
| 89 | done | |
| 90 | ||
| 91 | ||
| 92 | lemma Always_Follows1: | |
| 13805 | 93 |      "[| F \<in> Always {s. f s = f' s}; F \<in> f Fols g |] ==> F \<in> f' Fols g"
 | 
| 13796 | 94 | |
| 15102 | 95 | apply (simp add: Follows_def Increasing_def Stable_def, auto) | 
| 13796 | 96 | apply (erule_tac [3] Always_LeadsTo_weaken) | 
| 56248 
67dc9549fa15
generalized and strengthened cong rules on compound operators, similar to 1ed737a98198
 haftmann parents: 
54859diff
changeset | 97 | apply (erule_tac A = "{s. x \<le> f s}" and A' = "{s. x \<le> f s}" 
 | 
| 13798 | 98 | in Always_Constrains_weaken, auto) | 
| 13796 | 99 | apply (drule Always_Int_I, assumption) | 
| 100 | apply (force intro: Always_weaken) | |
| 101 | done | |
| 102 | ||
| 103 | lemma Always_Follows2: | |
| 13805 | 104 |      "[| F \<in> Always {s. g s = g' s}; F \<in> f Fols g |] ==> F \<in> f Fols g'"
 | 
| 15102 | 105 | apply (simp add: Follows_def Increasing_def Stable_def, auto) | 
| 13796 | 106 | apply (erule_tac [3] Always_LeadsTo_weaken) | 
| 56248 
67dc9549fa15
generalized and strengthened cong rules on compound operators, similar to 1ed737a98198
 haftmann parents: 
54859diff
changeset | 107 | apply (erule_tac A = "{s. x \<le> g s}" and A' = "{s. x \<le> g s}"
 | 
| 13798 | 108 | in Always_Constrains_weaken, auto) | 
| 13796 | 109 | apply (drule Always_Int_I, assumption) | 
| 110 | apply (force intro: Always_weaken) | |
| 111 | done | |
| 112 | ||
| 113 | ||
| 13798 | 114 | subsection{*Union properties (with the subset ordering)*}
 | 
| 13796 | 115 | |
| 116 | (*Can replace "Un" by any sup. But existing max only works for linorders.*) | |
| 56248 
67dc9549fa15
generalized and strengthened cong rules on compound operators, similar to 1ed737a98198
 haftmann parents: 
54859diff
changeset | 117 | |
| 13796 | 118 | lemma increasing_Un: | 
| 13805 | 119 | "[| F \<in> increasing f; F \<in> increasing g |] | 
| 120 | ==> F \<in> increasing (%s. (f s) \<union> (g s))" | |
| 15102 | 121 | apply (simp add: increasing_def stable_def constrains_def, auto) | 
| 56248 
67dc9549fa15
generalized and strengthened cong rules on compound operators, similar to 1ed737a98198
 haftmann parents: 
54859diff
changeset | 122 | apply (drule_tac x = "f xb" in spec) | 
| 
67dc9549fa15
generalized and strengthened cong rules on compound operators, similar to 1ed737a98198
 haftmann parents: 
54859diff
changeset | 123 | apply (drule_tac x = "g xb" in spec) | 
| 13796 | 124 | apply (blast dest!: bspec) | 
| 125 | done | |
| 126 | ||
| 127 | lemma Increasing_Un: | |
| 13805 | 128 | "[| F \<in> Increasing f; F \<in> Increasing g |] | 
| 129 | ==> F \<in> Increasing (%s. (f s) \<union> (g s))" | |
| 13798 | 130 | apply (auto simp add: Increasing_def Stable_def Constrains_def | 
| 131 | stable_def constrains_def) | |
| 56248 
67dc9549fa15
generalized and strengthened cong rules on compound operators, similar to 1ed737a98198
 haftmann parents: 
54859diff
changeset | 132 | apply (drule_tac x = "f xb" in spec) | 
| 
67dc9549fa15
generalized and strengthened cong rules on compound operators, similar to 1ed737a98198
 haftmann parents: 
54859diff
changeset | 133 | apply (drule_tac x = "g xb" in spec) | 
| 13796 | 134 | apply (blast dest!: bspec) | 
| 135 | done | |
| 136 | ||
| 137 | ||
| 138 | lemma Always_Un: | |
| 13805 | 139 |      "[| F \<in> Always {s. f' s \<le> f s}; F \<in> Always {s. g' s \<le> g s} |]  
 | 
| 140 |       ==> F \<in> Always {s. f' s \<union> g' s \<le> f s \<union> g s}"
 | |
| 13798 | 141 | by (simp add: Always_eq_includes_reachable, blast) | 
| 13796 | 142 | |
| 143 | (*Lemma to re-use the argument that one variable increases (progress) | |
| 144 | while the other variable doesn't decrease (safety)*) | |
| 145 | lemma Follows_Un_lemma: | |
| 13805 | 146 | "[| F \<in> Increasing f; F \<in> Increasing g; | 
| 147 |          F \<in> Increasing g'; F \<in> Always {s. f' s \<le> f s}; 
 | |
| 148 |          \<forall>k. F \<in> {s. k \<le> f s} LeadsTo {s. k \<le> f' s} |] 
 | |
| 149 |       ==> F \<in> {s. k \<le> f s \<union> g s} LeadsTo {s. k \<le> f' s \<union> g s}"
 | |
| 13796 | 150 | apply (rule single_LeadsTo_I) | 
| 151 | apply (drule_tac x = "f s" in IncreasingD) | |
| 152 | apply (drule_tac x = "g s" in IncreasingD) | |
| 153 | apply (rule LeadsTo_weaken) | |
| 154 | apply (rule PSP_Stable) | |
| 155 | apply (erule_tac x = "f s" in spec) | |
| 13812 
91713a1915ee
converting HOL/UNITY to use unconditional fairness
 paulson parents: 
13805diff
changeset | 156 | apply (erule Stable_Int, assumption, blast+) | 
| 13796 | 157 | done | 
| 158 | ||
| 159 | lemma Follows_Un: | |
| 13805 | 160 | "[| F \<in> f' Fols f; F \<in> g' Fols g |] | 
| 161 | ==> F \<in> (%s. (f' s) \<union> (g' s)) Fols (%s. (f s) \<union> (g s))" | |
| 54859 | 162 | apply (simp add: Follows_def Increasing_Un Always_Un del: Un_subset_iff sup.bounded_iff, auto) | 
| 13796 | 163 | apply (rule LeadsTo_Trans) | 
| 164 | apply (blast intro: Follows_Un_lemma) | |
| 165 | (*Weakening is used to exchange Un's arguments*) | |
| 166 | apply (blast intro: Follows_Un_lemma [THEN LeadsTo_weaken]) | |
| 167 | done | |
| 168 | ||
| 169 | ||
| 13798 | 170 | subsection{*Multiset union properties (with the multiset ordering)*}
 | 
| 60397 
f8a513fedb31
Renaming multiset operators < ~> <#,...
 Mathias Fleury <Mathias.Fleury@mpi-inf.mpg.de> parents: 
58889diff
changeset | 171 | (*TODO: remove when multiset is of sort ord again*) | 
| 
f8a513fedb31
Renaming multiset operators < ~> <#,...
 Mathias Fleury <Mathias.Fleury@mpi-inf.mpg.de> parents: 
58889diff
changeset | 172 | instantiation multiset :: (order) ordered_ab_semigroup_add | 
| 
f8a513fedb31
Renaming multiset operators < ~> <#,...
 Mathias Fleury <Mathias.Fleury@mpi-inf.mpg.de> parents: 
58889diff
changeset | 173 | begin | 
| 
f8a513fedb31
Renaming multiset operators < ~> <#,...
 Mathias Fleury <Mathias.Fleury@mpi-inf.mpg.de> parents: 
58889diff
changeset | 174 | |
| 
f8a513fedb31
Renaming multiset operators < ~> <#,...
 Mathias Fleury <Mathias.Fleury@mpi-inf.mpg.de> parents: 
58889diff
changeset | 175 | definition less_multiset :: "'a\<Colon>order multiset \<Rightarrow> 'a multiset \<Rightarrow> bool" where | 
| 
f8a513fedb31
Renaming multiset operators < ~> <#,...
 Mathias Fleury <Mathias.Fleury@mpi-inf.mpg.de> parents: 
58889diff
changeset | 176 | "M' < M \<longleftrightarrow> M' #<# M" | 
| 
f8a513fedb31
Renaming multiset operators < ~> <#,...
 Mathias Fleury <Mathias.Fleury@mpi-inf.mpg.de> parents: 
58889diff
changeset | 177 | |
| 
f8a513fedb31
Renaming multiset operators < ~> <#,...
 Mathias Fleury <Mathias.Fleury@mpi-inf.mpg.de> parents: 
58889diff
changeset | 178 | definition less_eq_multiset :: "'a multiset \<Rightarrow> 'a multiset \<Rightarrow> bool" where | 
| 
f8a513fedb31
Renaming multiset operators < ~> <#,...
 Mathias Fleury <Mathias.Fleury@mpi-inf.mpg.de> parents: 
58889diff
changeset | 179 | "(M'::'a multiset) \<le> M \<longleftrightarrow> M' #<=# M" | 
| 
f8a513fedb31
Renaming multiset operators < ~> <#,...
 Mathias Fleury <Mathias.Fleury@mpi-inf.mpg.de> parents: 
58889diff
changeset | 180 | |
| 
f8a513fedb31
Renaming multiset operators < ~> <#,...
 Mathias Fleury <Mathias.Fleury@mpi-inf.mpg.de> parents: 
58889diff
changeset | 181 | instance | 
| 
f8a513fedb31
Renaming multiset operators < ~> <#,...
 Mathias Fleury <Mathias.Fleury@mpi-inf.mpg.de> parents: 
58889diff
changeset | 182 | by default (auto simp add: less_eq_multiset_def less_multiset_def multiset_order.less_le_not_le add.commute multiset_order.add_right_mono) | 
| 
f8a513fedb31
Renaming multiset operators < ~> <#,...
 Mathias Fleury <Mathias.Fleury@mpi-inf.mpg.de> parents: 
58889diff
changeset | 183 | end | 
| 13796 | 184 | |
| 185 | lemma increasing_union: | |
| 13805 | 186 | "[| F \<in> increasing f; F \<in> increasing g |] | 
| 187 |      ==> F \<in> increasing (%s. (f s) + (g s :: ('a::order) multiset))"
 | |
| 15102 | 188 | apply (simp add: increasing_def stable_def constrains_def, auto) | 
| 56248 
67dc9549fa15
generalized and strengthened cong rules on compound operators, similar to 1ed737a98198
 haftmann parents: 
54859diff
changeset | 189 | apply (drule_tac x = "f xb" in spec) | 
| 
67dc9549fa15
generalized and strengthened cong rules on compound operators, similar to 1ed737a98198
 haftmann parents: 
54859diff
changeset | 190 | apply (drule_tac x = "g xb" in spec) | 
| 13796 | 191 | apply (drule bspec, assumption) | 
| 35274 | 192 | apply (blast intro: add_mono order_trans) | 
| 13796 | 193 | done | 
| 194 | ||
| 195 | lemma Increasing_union: | |
| 13805 | 196 | "[| F \<in> Increasing f; F \<in> Increasing g |] | 
| 197 |      ==> F \<in> Increasing (%s. (f s) + (g s :: ('a::order) multiset))"
 | |
| 13798 | 198 | apply (auto simp add: Increasing_def Stable_def Constrains_def | 
| 199 | stable_def constrains_def) | |
| 56248 
67dc9549fa15
generalized and strengthened cong rules on compound operators, similar to 1ed737a98198
 haftmann parents: 
54859diff
changeset | 200 | apply (drule_tac x = "f xb" in spec) | 
| 
67dc9549fa15
generalized and strengthened cong rules on compound operators, similar to 1ed737a98198
 haftmann parents: 
54859diff
changeset | 201 | apply (drule_tac x = "g xb" in spec) | 
| 13796 | 202 | apply (drule bspec, assumption) | 
| 35274 | 203 | apply (blast intro: add_mono order_trans) | 
| 13796 | 204 | done | 
| 205 | ||
| 206 | lemma Always_union: | |
| 13805 | 207 |      "[| F \<in> Always {s. f' s \<le> f s}; F \<in> Always {s. g' s \<le> g s} |]  
 | 
| 208 |       ==> F \<in> Always {s. f' s + g' s \<le> f s + (g s :: ('a::order) multiset)}"
 | |
| 13796 | 209 | apply (simp add: Always_eq_includes_reachable) | 
| 35274 | 210 | apply (blast intro: add_mono) | 
| 13796 | 211 | done | 
| 212 | ||
| 213 | (*Except the last line, IDENTICAL to the proof script for Follows_Un_lemma*) | |
| 214 | lemma Follows_union_lemma: | |
| 13805 | 215 | "[| F \<in> Increasing f; F \<in> Increasing g; | 
| 216 |          F \<in> Increasing g'; F \<in> Always {s. f' s \<le> f s}; 
 | |
| 217 |          \<forall>k::('a::order) multiset.  
 | |
| 218 |            F \<in> {s. k \<le> f s} LeadsTo {s. k \<le> f' s} |] 
 | |
| 219 |       ==> F \<in> {s. k \<le> f s + g s} LeadsTo {s. k \<le> f' s + g s}"
 | |
| 13796 | 220 | apply (rule single_LeadsTo_I) | 
| 221 | apply (drule_tac x = "f s" in IncreasingD) | |
| 222 | apply (drule_tac x = "g s" in IncreasingD) | |
| 223 | apply (rule LeadsTo_weaken) | |
| 224 | apply (rule PSP_Stable) | |
| 225 | apply (erule_tac x = "f s" in spec) | |
| 13812 
91713a1915ee
converting HOL/UNITY to use unconditional fairness
 paulson parents: 
13805diff
changeset | 226 | apply (erule Stable_Int, assumption, blast) | 
| 35274 | 227 | apply (blast intro: add_mono order_trans) | 
| 13796 | 228 | done | 
| 229 | ||
| 230 | (*The !! is there to influence to effect of permutative rewriting at the end*) | |
| 231 | lemma Follows_union: | |
| 232 |      "!!g g' ::'b => ('a::order) multiset.  
 | |
| 13805 | 233 | [| F \<in> f' Fols f; F \<in> g' Fols g |] | 
| 234 | ==> F \<in> (%s. (f' s) + (g' s)) Fols (%s. (f s) + (g s))" | |
| 15102 | 235 | apply (simp add: Follows_def) | 
| 13796 | 236 | apply (simp add: Increasing_union Always_union, auto) | 
| 237 | apply (rule LeadsTo_Trans) | |
| 238 | apply (blast intro: Follows_union_lemma) | |
| 239 | (*now exchange union's arguments*) | |
| 240 | apply (simp add: union_commute) | |
| 241 | apply (blast intro: Follows_union_lemma) | |
| 242 | done | |
| 243 | ||
| 244 | lemma Follows_setsum: | |
| 245 |      "!!f ::['c,'b] => ('a::order) multiset.  
 | |
| 13805 | 246 | [| \<forall>i \<in> I. F \<in> f' i Fols f i; finite I |] | 
| 247 | ==> F \<in> (%s. \<Sum>i \<in> I. f' i s) Fols (%s. \<Sum>i \<in> I. f i s)" | |
| 13796 | 248 | apply (erule rev_mp) | 
| 249 | apply (erule finite_induct, simp) | |
| 250 | apply (simp add: Follows_union) | |
| 251 | done | |
| 252 | ||
| 253 | ||
| 254 | (*Currently UNUSED, but possibly of interest*) | |
| 255 | lemma Increasing_imp_Stable_pfixGe: | |
| 13805 | 256 |      "F \<in> Increasing func ==> F \<in> Stable {s. h pfixGe (func s)}"
 | 
| 13796 | 257 | apply (simp add: Increasing_def Stable_def Constrains_def constrains_def) | 
| 258 | apply (blast intro: trans_Ge [THEN trans_genPrefix, THEN transD] | |
| 259 | prefix_imp_pfixGe) | |
| 260 | done | |
| 261 | ||
| 262 | (*Currently UNUSED, but possibly of interest*) | |
| 263 | lemma LeadsTo_le_imp_pfixGe: | |
| 13805 | 264 |      "\<forall>z. F \<in> {s. z \<le> f s} LeadsTo {s. z \<le> g s}  
 | 
| 265 |       ==> F \<in> {s. z pfixGe f s} LeadsTo {s. z pfixGe g s}"
 | |
| 13796 | 266 | apply (rule single_LeadsTo_I) | 
| 267 | apply (drule_tac x = "f s" in spec) | |
| 268 | apply (erule LeadsTo_weaken) | |
| 269 | prefer 2 | |
| 270 | apply (blast intro: trans_Ge [THEN trans_genPrefix, THEN transD] | |
| 271 | prefix_imp_pfixGe, blast) | |
| 272 | done | |
| 273 | ||
| 6706 | 274 | end |