wenzelm@32960: (* Title: HOL/UNITY/UNITY.thy paulson@4776: Author: Lawrence C Paulson, Cambridge University Computer Laboratory paulson@4776: Copyright 1998 University of Cambridge paulson@4776: wenzelm@32960: The basic UNITY theory (revised version, based upon the "co" wenzelm@32960: operator). paulson@4776: wenzelm@32960: From Misra, "A Logic for Concurrent Programming", 1994. paulson@4776: *) paulson@4776: wenzelm@58889: section {*The Basic UNITY Theory*} paulson@13798: haftmann@16417: theory UNITY imports Main begin paulson@6535: wenzelm@45694: definition wenzelm@45694: "Program = wenzelm@45694: {(init:: 'a set, acts :: ('a * 'a)set set, wenzelm@45694: allowed :: ('a * 'a)set set). Id \ acts & Id: allowed}" wenzelm@45694: wenzelm@49834: typedef 'a program = "Program :: ('a set * ('a * 'a) set set * ('a * 'a) set set) set" wenzelm@45694: morphisms Rep_Program Abs_Program wenzelm@45694: unfolding Program_def by blast paulson@6536: haftmann@35416: definition Acts :: "'a program => ('a * 'a)set set" where wenzelm@14653: "Acts F == (%(init, acts, allowed). acts) (Rep_Program F)" wenzelm@14653: haftmann@35416: definition "constrains" :: "['a set, 'a set] => 'a program set" (infixl "co" 60) where paulson@13805: "A co B == {F. \act \ Acts F. act``A \ B}" paulson@13797: haftmann@35416: definition unless :: "['a set, 'a set] => 'a program set" (infixl "unless" 60) where paulson@13805: "A unless B == (A-B) co (A \ B)" paulson@13797: haftmann@35416: definition mk_program :: "('a set * ('a * 'a)set set * ('a * 'a)set set) haftmann@35416: => 'a program" where paulson@10064: "mk_program == %(init, acts, allowed). paulson@10064: Abs_Program (init, insert Id acts, insert Id allowed)" paulson@6535: haftmann@35416: definition Init :: "'a program => 'a set" where paulson@10064: "Init F == (%(init, acts, allowed). init) (Rep_Program F)" paulson@6535: haftmann@35416: definition AllowedActs :: "'a program => ('a * 'a)set set" where paulson@10064: "AllowedActs F == (%(init, acts, allowed). allowed) (Rep_Program F)" paulson@10064: haftmann@35416: definition Allowed :: "'a program => 'a program set" where paulson@13805: "Allowed F == {G. Acts G \ AllowedActs F}" paulson@4776: haftmann@35416: definition stable :: "'a set => 'a program set" where paulson@6536: "stable A == A co A" paulson@4776: haftmann@35416: definition strongest_rhs :: "['a program, 'a set] => 'a set" where paulson@13805: "strongest_rhs F A == Inter {B. F \ A co B}" paulson@4776: haftmann@35416: definition invariant :: "'a set => 'a program set" where paulson@13805: "invariant A == {F. Init F \ A} \ stable A" paulson@4776: haftmann@35416: definition increasing :: "['a => 'b::{order}] => 'a program set" where paulson@13812: --{*Polymorphic in both states and the meaning of @{text "\"}*} paulson@13805: "increasing f == \z. stable {s. z \ f s}" paulson@4776: paulson@6536: paulson@16184: subsubsection{*The abstract type of programs*} paulson@13797: paulson@13797: lemmas program_typedef = paulson@13797: Rep_Program Rep_Program_inverse Abs_Program_inverse paulson@13797: Program_def Init_def Acts_def AllowedActs_def mk_program_def paulson@13797: paulson@13805: lemma Id_in_Acts [iff]: "Id \ Acts F" paulson@13797: apply (cut_tac x = F in Rep_Program) paulson@13797: apply (auto simp add: program_typedef) paulson@13797: done paulson@13797: paulson@13797: lemma insert_Id_Acts [iff]: "insert Id (Acts F) = Acts F" wenzelm@46577: by (simp add: insert_absorb) paulson@13797: paulson@13861: lemma Acts_nonempty [simp]: "Acts F \ {}" paulson@13861: by auto paulson@13861: paulson@13805: lemma Id_in_AllowedActs [iff]: "Id \ AllowedActs F" paulson@13797: apply (cut_tac x = F in Rep_Program) paulson@13797: apply (auto simp add: program_typedef) paulson@13797: done paulson@13797: paulson@13797: lemma insert_Id_AllowedActs [iff]: "insert Id (AllowedActs F) = AllowedActs F" wenzelm@46577: by (simp add: insert_absorb) paulson@13797: paulson@16184: subsubsection{*Inspectors for type "program"*} paulson@13797: paulson@13797: lemma Init_eq [simp]: "Init (mk_program (init,acts,allowed)) = init" paulson@13812: by (simp add: program_typedef) paulson@13797: paulson@13797: lemma Acts_eq [simp]: "Acts (mk_program (init,acts,allowed)) = insert Id acts" paulson@13812: by (simp add: program_typedef) paulson@13797: paulson@13797: lemma AllowedActs_eq [simp]: paulson@13797: "AllowedActs (mk_program (init,acts,allowed)) = insert Id allowed" paulson@13812: by (simp add: program_typedef) paulson@13797: paulson@16184: subsubsection{*Equality for UNITY programs*} paulson@13797: paulson@13797: lemma surjective_mk_program [simp]: paulson@13797: "mk_program (Init F, Acts F, AllowedActs F) = F" paulson@13797: apply (cut_tac x = F in Rep_Program) paulson@13797: apply (auto simp add: program_typedef) paulson@13797: apply (drule_tac f = Abs_Program in arg_cong)+ paulson@13797: apply (simp add: program_typedef insert_absorb) paulson@13797: done paulson@13797: paulson@13797: lemma program_equalityI: paulson@13797: "[| Init F = Init G; Acts F = Acts G; AllowedActs F = AllowedActs G |] paulson@13797: ==> F = G" paulson@13797: apply (rule_tac t = F in surjective_mk_program [THEN subst]) paulson@13797: apply (rule_tac t = G in surjective_mk_program [THEN subst], simp) paulson@13797: done paulson@13797: paulson@13797: lemma program_equalityE: paulson@13797: "[| F = G; paulson@13797: [| Init F = Init G; Acts F = Acts G; AllowedActs F = AllowedActs G |] paulson@13797: ==> P |] ==> P" paulson@13797: by simp paulson@13797: paulson@13797: lemma program_equality_iff: paulson@13797: "(F=G) = paulson@13797: (Init F = Init G & Acts F = Acts G &AllowedActs F = AllowedActs G)" paulson@13797: by (blast intro: program_equalityI program_equalityE) paulson@13797: paulson@13797: paulson@16184: subsubsection{*co*} paulson@13797: paulson@13797: lemma constrainsI: paulson@13805: "(!!act s s'. [| act: Acts F; (s,s') \ act; s \ A |] ==> s': A') paulson@13805: ==> F \ A co A'" paulson@13797: by (simp add: constrains_def, blast) paulson@13797: paulson@13797: lemma constrainsD: paulson@13805: "[| F \ A co A'; act: Acts F; (s,s'): act; s \ A |] ==> s': A'" paulson@13797: by (unfold constrains_def, blast) paulson@13797: paulson@13805: lemma constrains_empty [iff]: "F \ {} co B" paulson@13797: by (unfold constrains_def, blast) paulson@13797: paulson@13805: lemma constrains_empty2 [iff]: "(F \ A co {}) = (A={})" paulson@13797: by (unfold constrains_def, blast) paulson@13797: paulson@13805: lemma constrains_UNIV [iff]: "(F \ UNIV co B) = (B = UNIV)" paulson@13797: by (unfold constrains_def, blast) paulson@13797: paulson@13805: lemma constrains_UNIV2 [iff]: "F \ A co UNIV" paulson@13797: by (unfold constrains_def, blast) paulson@13797: paulson@13812: text{*monotonic in 2nd argument*} paulson@13797: lemma constrains_weaken_R: paulson@13805: "[| F \ A co A'; A'<=B' |] ==> F \ A co B'" paulson@13797: by (unfold constrains_def, blast) paulson@13797: paulson@13812: text{*anti-monotonic in 1st argument*} paulson@13797: lemma constrains_weaken_L: paulson@13805: "[| F \ A co A'; B \ A |] ==> F \ B co A'" paulson@13797: by (unfold constrains_def, blast) paulson@13797: paulson@13797: lemma constrains_weaken: paulson@13805: "[| F \ A co A'; B \ A; A'<=B' |] ==> F \ B co B'" paulson@13797: by (unfold constrains_def, blast) paulson@13797: paulson@16184: subsubsection{*Union*} paulson@13797: paulson@13797: lemma constrains_Un: paulson@13805: "[| F \ A co A'; F \ B co B' |] ==> F \ (A \ B) co (A' \ B')" paulson@13797: by (unfold constrains_def, blast) paulson@13797: paulson@13797: lemma constrains_UN: paulson@13805: "(!!i. i \ I ==> F \ (A i) co (A' i)) paulson@13805: ==> F \ (\i \ I. A i) co (\i \ I. A' i)" paulson@13797: by (unfold constrains_def, blast) paulson@13797: paulson@13805: lemma constrains_Un_distrib: "(A \ B) co C = (A co C) \ (B co C)" paulson@13797: by (unfold constrains_def, blast) paulson@13797: paulson@13805: lemma constrains_UN_distrib: "(\i \ I. A i) co B = (\i \ I. A i co B)" paulson@13797: by (unfold constrains_def, blast) paulson@13797: paulson@13805: lemma constrains_Int_distrib: "C co (A \ B) = (C co A) \ (C co B)" paulson@13797: by (unfold constrains_def, blast) paulson@13797: paulson@13805: lemma constrains_INT_distrib: "A co (\i \ I. B i) = (\i \ I. A co B i)" paulson@13797: by (unfold constrains_def, blast) paulson@13797: paulson@16184: subsubsection{*Intersection*} paulson@6536: paulson@13797: lemma constrains_Int: paulson@13805: "[| F \ A co A'; F \ B co B' |] ==> F \ (A \ B) co (A' \ B')" paulson@13797: by (unfold constrains_def, blast) paulson@13797: paulson@13797: lemma constrains_INT: paulson@13805: "(!!i. i \ I ==> F \ (A i) co (A' i)) paulson@13805: ==> F \ (\i \ I. A i) co (\i \ I. A' i)" paulson@13797: by (unfold constrains_def, blast) paulson@13797: paulson@13805: lemma constrains_imp_subset: "F \ A co A' ==> A \ A'" paulson@13797: by (unfold constrains_def, auto) paulson@13797: paulson@13812: text{*The reasoning is by subsets since "co" refers to single actions paulson@13812: only. So this rule isn't that useful.*} paulson@13797: lemma constrains_trans: paulson@13805: "[| F \ A co B; F \ B co C |] ==> F \ A co C" paulson@13797: by (unfold constrains_def, blast) paulson@13797: paulson@13797: lemma constrains_cancel: paulson@13805: "[| F \ A co (A' \ B); F \ B co B' |] ==> F \ A co (A' \ B')" paulson@13797: by (unfold constrains_def, clarify, blast) paulson@13797: paulson@13797: paulson@16184: subsubsection{*unless*} paulson@13797: paulson@13805: lemma unlessI: "F \ (A-B) co (A \ B) ==> F \ A unless B" paulson@13797: by (unfold unless_def, assumption) paulson@13797: paulson@13805: lemma unlessD: "F \ A unless B ==> F \ (A-B) co (A \ B)" paulson@13797: by (unfold unless_def, assumption) paulson@13797: paulson@13797: paulson@16184: subsubsection{*stable*} paulson@13797: paulson@13805: lemma stableI: "F \ A co A ==> F \ stable A" paulson@13797: by (unfold stable_def, assumption) paulson@13797: paulson@13805: lemma stableD: "F \ stable A ==> F \ A co A" paulson@13797: by (unfold stable_def, assumption) paulson@13797: paulson@13797: lemma stable_UNIV [simp]: "stable UNIV = UNIV" paulson@13797: by (unfold stable_def constrains_def, auto) paulson@13797: paulson@16184: subsubsection{*Union*} paulson@13797: paulson@13797: lemma stable_Un: paulson@13805: "[| F \ stable A; F \ stable A' |] ==> F \ stable (A \ A')" paulson@13797: paulson@13797: apply (unfold stable_def) paulson@13797: apply (blast intro: constrains_Un) paulson@13797: done paulson@13797: paulson@13797: lemma stable_UN: paulson@13805: "(!!i. i \ I ==> F \ stable (A i)) ==> F \ stable (\i \ I. A i)" paulson@13797: apply (unfold stable_def) paulson@13797: apply (blast intro: constrains_UN) paulson@13797: done paulson@13797: paulson@13870: lemma stable_Union: paulson@13870: "(!!A. A \ X ==> F \ stable A) ==> F \ stable (\X)" paulson@13870: by (unfold stable_def constrains_def, blast) paulson@13870: paulson@16184: subsubsection{*Intersection*} paulson@13797: paulson@13797: lemma stable_Int: paulson@13805: "[| F \ stable A; F \ stable A' |] ==> F \ stable (A \ A')" paulson@13797: apply (unfold stable_def) paulson@13797: apply (blast intro: constrains_Int) paulson@13797: done paulson@13797: paulson@13797: lemma stable_INT: paulson@13805: "(!!i. i \ I ==> F \ stable (A i)) ==> F \ stable (\i \ I. A i)" paulson@13797: apply (unfold stable_def) paulson@13797: apply (blast intro: constrains_INT) paulson@13797: done paulson@13797: paulson@13870: lemma stable_Inter: paulson@13870: "(!!A. A \ X ==> F \ stable A) ==> F \ stable (\X)" paulson@13870: by (unfold stable_def constrains_def, blast) paulson@13870: paulson@13797: lemma stable_constrains_Un: paulson@13805: "[| F \ stable C; F \ A co (C \ A') |] ==> F \ (C \ A) co (C \ A')" paulson@13797: by (unfold stable_def constrains_def, blast) paulson@13797: paulson@13797: lemma stable_constrains_Int: paulson@13805: "[| F \ stable C; F \ (C \ A) co A' |] ==> F \ (C \ A) co (C \ A')" paulson@13797: by (unfold stable_def constrains_def, blast) paulson@13797: paulson@13805: (*[| F \ stable C; F \ (C \ A) co A |] ==> F \ stable (C \ A) *) wenzelm@45605: lemmas stable_constrains_stable = stable_constrains_Int[THEN stableI] paulson@13797: paulson@13797: paulson@16184: subsubsection{*invariant*} paulson@13797: paulson@13805: lemma invariantI: "[| Init F \ A; F \ stable A |] ==> F \ invariant A" paulson@13797: by (simp add: invariant_def) paulson@13797: paulson@14150: text{*Could also say @{term "invariant A \ invariant B \ invariant(A \ B)"}*} paulson@13797: lemma invariant_Int: paulson@13805: "[| F \ invariant A; F \ invariant B |] ==> F \ invariant (A \ B)" paulson@13797: by (auto simp add: invariant_def stable_Int) paulson@13797: paulson@13797: paulson@16184: subsubsection{*increasing*} paulson@13797: paulson@13797: lemma increasingD: paulson@13805: "F \ increasing f ==> F \ stable {s. z \ f s}" paulson@13797: by (unfold increasing_def, blast) paulson@13797: paulson@13805: lemma increasing_constant [iff]: "F \ increasing (%s. c)" paulson@13797: by (unfold increasing_def stable_def, auto) paulson@13797: paulson@13797: lemma mono_increasing_o: paulson@13805: "mono g ==> increasing f \ increasing (g o f)" paulson@13797: apply (unfold increasing_def stable_def constrains_def, auto) paulson@13797: apply (blast intro: monoD order_trans) paulson@13797: done paulson@13797: paulson@13805: (*Holds by the theorem (Suc m \ n) = (m < n) *) paulson@13797: lemma strict_increasingD: paulson@13805: "!!z::nat. F \ increasing f ==> F \ stable {s. z < f s}" paulson@13797: by (simp add: increasing_def Suc_le_eq [symmetric]) paulson@13797: paulson@13797: paulson@13797: (** The Elimination Theorem. The "free" m has become universally quantified! paulson@13805: Should the premise be !!m instead of \m ? Would make it harder to use paulson@13797: in forward proof. **) paulson@13797: paulson@13797: lemma elimination: paulson@13805: "[| \m \ M. F \ {s. s x = m} co (B m) |] paulson@13805: ==> F \ {s. s x \ M} co (\m \ M. B m)" paulson@13797: by (unfold constrains_def, blast) paulson@13797: paulson@13812: text{*As above, but for the trivial case of a one-variable state, in which the paulson@13812: state is identified with its one variable.*} paulson@13797: lemma elimination_sing: paulson@13805: "(\m \ M. F \ {m} co (B m)) ==> F \ M co (\m \ M. B m)" paulson@13797: by (unfold constrains_def, blast) paulson@13797: paulson@13797: paulson@13797: paulson@16184: subsubsection{*Theoretical Results from Section 6*} paulson@13797: paulson@13797: lemma constrains_strongest_rhs: paulson@13805: "F \ A co (strongest_rhs F A )" paulson@13797: by (unfold constrains_def strongest_rhs_def, blast) paulson@13797: paulson@13797: lemma strongest_rhs_is_strongest: paulson@13805: "F \ A co B ==> strongest_rhs F A \ B" paulson@13797: by (unfold constrains_def strongest_rhs_def, blast) paulson@13797: paulson@13797: paulson@16184: subsubsection{*Ad-hoc set-theory rules*} paulson@13797: paulson@13805: lemma Un_Diff_Diff [simp]: "A \ B - (A - B) = B" paulson@13797: by blast paulson@13797: paulson@13805: lemma Int_Union_Union: "Union(B) \ A = Union((%C. C \ A)`B)" paulson@13797: by blast paulson@13797: wenzelm@24147: text{*Needed for WF reasoning in WFair.thy*} paulson@13797: paulson@13797: lemma Image_less_than [simp]: "less_than `` {k} = greaterThan k" paulson@13797: by blast paulson@13797: paulson@13797: lemma Image_inverse_less_than [simp]: "less_than^-1 `` {k} = lessThan k" paulson@13797: by blast paulson@6536: paulson@13812: paulson@13812: subsection{*Partial versus Total Transitions*} paulson@13812: haftmann@35416: definition totalize_act :: "('a * 'a)set => ('a * 'a)set" where nipkow@30198: "totalize_act act == act \ Id_on (-(Domain act))" paulson@13812: haftmann@35416: definition totalize :: "'a program => 'a program" where paulson@13812: "totalize F == mk_program (Init F, wenzelm@32960: totalize_act ` Acts F, wenzelm@32960: AllowedActs F)" paulson@13812: haftmann@35416: definition mk_total_program :: "('a set * ('a * 'a)set set * ('a * 'a)set set) haftmann@35416: => 'a program" where paulson@13812: "mk_total_program args == totalize (mk_program args)" paulson@13812: haftmann@35416: definition all_total :: "'a program => bool" where paulson@13812: "all_total F == \act \ Acts F. Domain act = UNIV" paulson@13812: paulson@13812: lemma insert_Id_image_Acts: "f Id = Id ==> insert Id (f`Acts F) = f ` Acts F" paulson@13812: by (blast intro: sym [THEN image_eqI]) paulson@13812: paulson@13812: paulson@16184: subsubsection{*Basic properties*} paulson@13812: paulson@13812: lemma totalize_act_Id [simp]: "totalize_act Id = Id" paulson@13812: by (simp add: totalize_act_def) paulson@13812: paulson@13812: lemma Domain_totalize_act [simp]: "Domain (totalize_act act) = UNIV" paulson@13812: by (auto simp add: totalize_act_def) paulson@13812: paulson@13812: lemma Init_totalize [simp]: "Init (totalize F) = Init F" paulson@13812: by (unfold totalize_def, auto) paulson@13812: paulson@13812: lemma Acts_totalize [simp]: "Acts (totalize F) = (totalize_act ` Acts F)" paulson@13812: by (simp add: totalize_def insert_Id_image_Acts) paulson@13812: paulson@13812: lemma AllowedActs_totalize [simp]: "AllowedActs (totalize F) = AllowedActs F" paulson@13812: by (simp add: totalize_def) paulson@13812: paulson@13812: lemma totalize_constrains_iff [simp]: "(totalize F \ A co B) = (F \ A co B)" paulson@13812: by (simp add: totalize_def totalize_act_def constrains_def, blast) paulson@13812: paulson@13812: lemma totalize_stable_iff [simp]: "(totalize F \ stable A) = (F \ stable A)" paulson@13812: by (simp add: stable_def) paulson@13812: paulson@13812: lemma totalize_invariant_iff [simp]: paulson@13812: "(totalize F \ invariant A) = (F \ invariant A)" paulson@13812: by (simp add: invariant_def) paulson@13812: paulson@13812: lemma all_total_totalize: "all_total (totalize F)" paulson@13812: by (simp add: totalize_def all_total_def) paulson@13812: paulson@13812: lemma Domain_iff_totalize_act: "(Domain act = UNIV) = (totalize_act act = act)" paulson@13812: by (force simp add: totalize_act_def) paulson@13812: paulson@13812: lemma all_total_imp_totalize: "all_total F ==> (totalize F = F)" paulson@13812: apply (simp add: all_total_def totalize_def) paulson@13812: apply (rule program_equalityI) paulson@13812: apply (simp_all add: Domain_iff_totalize_act image_def) paulson@13812: done paulson@13812: paulson@13812: lemma all_total_iff_totalize: "all_total F = (totalize F = F)" paulson@13812: apply (rule iffI) paulson@13812: apply (erule all_total_imp_totalize) paulson@13812: apply (erule subst) paulson@13812: apply (rule all_total_totalize) paulson@13812: done paulson@13812: paulson@13812: lemma mk_total_program_constrains_iff [simp]: paulson@13812: "(mk_total_program args \ A co B) = (mk_program args \ A co B)" paulson@13812: by (simp add: mk_total_program_def) paulson@13812: paulson@13812: paulson@13812: subsection{*Rules for Lazy Definition Expansion*} paulson@13812: paulson@13812: text{*They avoid expanding the full program, which is a large expression*} paulson@13812: paulson@13812: lemma def_prg_Init: wenzelm@36866: "F = mk_total_program (init,acts,allowed) ==> Init F = init" paulson@13812: by (simp add: mk_total_program_def) paulson@13812: paulson@13812: lemma def_prg_Acts: wenzelm@36866: "F = mk_total_program (init,acts,allowed) paulson@13812: ==> Acts F = insert Id (totalize_act ` acts)" paulson@13812: by (simp add: mk_total_program_def) paulson@13812: paulson@13812: lemma def_prg_AllowedActs: wenzelm@36866: "F = mk_total_program (init,acts,allowed) paulson@13812: ==> AllowedActs F = insert Id allowed" paulson@13812: by (simp add: mk_total_program_def) paulson@13812: paulson@13812: text{*An action is expanded if a pair of states is being tested against it*} paulson@13812: lemma def_act_simp: wenzelm@36866: "act = {(s,s'). P s s'} ==> ((s,s') \ act) = P s s'" paulson@13812: by (simp add: mk_total_program_def) paulson@13812: paulson@13812: text{*A set is expanded only if an element is being tested against it*} wenzelm@36866: lemma def_set_simp: "A = B ==> (x \ A) = (x \ B)" paulson@13812: by (simp add: mk_total_program_def) paulson@13812: paulson@16184: subsubsection{*Inspectors for type "program"*} paulson@13812: paulson@13812: lemma Init_total_eq [simp]: paulson@13812: "Init (mk_total_program (init,acts,allowed)) = init" paulson@13812: by (simp add: mk_total_program_def) paulson@13812: paulson@13812: lemma Acts_total_eq [simp]: paulson@13812: "Acts(mk_total_program(init,acts,allowed)) = insert Id (totalize_act`acts)" paulson@13812: by (simp add: mk_total_program_def) paulson@13812: paulson@13812: lemma AllowedActs_total_eq [simp]: paulson@13812: "AllowedActs (mk_total_program (init,acts,allowed)) = insert Id allowed" paulson@13812: by (auto simp add: mk_total_program_def) paulson@13812: paulson@4776: end