# HG changeset patch # User paulson # Date 1666183140 -3600 # Node ID e4fa45571bab69b8382d2207185d7098f39fb0e2 # Parent b45c8e35231ee11f018b42017f8a77cc4a8965d4 A bit of tidying diff -r b45c8e35231e -r e4fa45571bab src/HOL/Auth/Message.thy --- a/src/HOL/Auth/Message.thy Tue Oct 18 15:59:15 2022 +0100 +++ b/src/HOL/Auth/Message.thy Wed Oct 19 13:39:00 2022 +0100 @@ -86,10 +86,10 @@ text\Equations hold because constructors are injective.\ -lemma Friend_image_eq [simp]: "(Friend x \ Friend`A) = (x\A)" +lemma Friend_image_eq [simp]: "(Friend x \ Friend`A) = (x \A)" by auto -lemma Key_image_eq [simp]: "(Key x \ Key`A) = (x\A)" +lemma Key_image_eq [simp]: "(Key x \ Key`A) = (x \A)" by auto lemma Nonce_Key_image_eq [simp]: "(Nonce x \ Key`A)" @@ -110,7 +110,7 @@ lemma keysFor_Un [simp]: "keysFor (H \ H') = keysFor H \ keysFor H'" unfolding keysFor_def by blast -lemma keysFor_UN [simp]: "keysFor (\i\A. H i) = (\i\A. keysFor (H i))" +lemma keysFor_UN [simp]: "keysFor (\i \A. H i) = (\i \A. keysFor (H i))" unfolding keysFor_def by blast text\Monotonicity\ @@ -170,11 +170,11 @@ lemma parts_empty [simp]: "parts{} = {}" using parts_empty_aux by blast -lemma parts_emptyE [elim!]: "X\ parts{} \ P" +lemma parts_emptyE [elim!]: "X \ parts{} \ P" by simp text\WARNING: loops if H = {Y}, therefore must not be repeated!\ -lemma parts_singleton: "X \ parts H \ \Y\H. X \ parts {Y}" +lemma parts_singleton: "X \ parts H \ \Y \H. X \ parts {Y}" by (erule parts.induct, fast+) @@ -200,20 +200,20 @@ "parts (insert X (insert Y H)) = parts {X} \ parts {Y} \ parts H" by (metis Un_commute Un_empty_right Un_insert_right insert_is_Un parts_Un) -lemma parts_UN_subset1: "(\x\A. parts(H x)) \ parts(\x\A. H x)" +lemma parts_UN_subset1: "(\x \A. parts(H x)) \ parts(\x \A. H x)" by (intro UN_least parts_mono UN_upper) -lemma parts_UN_subset2: "parts(\x\A. H x) \ (\x\A. parts(H x))" +lemma parts_UN_subset2: "parts(\x \A. H x) \ (\x \A. parts(H x))" apply (rule subsetI) apply (erule parts.induct, blast+) done lemma parts_UN [simp]: - "parts (\x\A. H x) = (\x\A. parts (H x))" + "parts (\x \A. H x) = (\x \A. parts (H x))" by (intro equalityI parts_UN_subset1 parts_UN_subset2) lemma parts_image [simp]: - "parts (f ` A) = (\x\A. parts {f x})" + "parts (f ` A) = (\x \A. parts {f x})" apply auto apply (metis (mono_tags, opaque_lifting) image_iff parts_singleton) apply (metis empty_subsetI image_eqI insert_absorb insert_subset parts_mono) @@ -234,7 +234,7 @@ subsubsection\Idempotence and transitivity\ -lemma parts_partsD [dest!]: "X\ parts (parts H) \ X\ parts H" +lemma parts_partsD [dest!]: "X \ parts (parts H) \ X \ parts H" by (erule parts.induct, blast+) lemma parts_idem [simp]: "parts (parts H) = parts H" @@ -243,15 +243,15 @@ lemma parts_subset_iff [simp]: "(parts G \ parts H) = (G \ parts H)" by (metis parts_idem parts_increasing parts_mono subset_trans) -lemma parts_trans: "\X\ parts G; G \ parts H\ \ X\ parts H" +lemma parts_trans: "\X \ parts G; G \ parts H\ \ X \ parts H" by (metis parts_subset_iff subsetD) text\Cut\ lemma parts_cut: - "\Y\ parts (insert X G); X\ parts H\ \ Y\ parts (G \ H)" + "\Y \ parts (insert X G); X \ parts H\ \ Y \ parts (G \ H)" by (blast intro: parts_trans) -lemma parts_cut_eq [simp]: "X\ parts H \ parts (insert X H) = parts H" +lemma parts_cut_eq [simp]: "X \ parts H \ parts (insert X H) = parts H" by (metis insert_absorb parts_idem parts_insert) @@ -491,7 +491,7 @@ subsubsection\Idempotence and transitivity\ -lemma analz_analzD [dest!]: "X\ analz (analz H) \ X\ analz H" +lemma analz_analzD [dest!]: "X \ analz (analz H) \ X \ analz H" by (erule analz.induct, blast+) lemma analz_idem [simp]: "analz (analz H) = analz H" @@ -500,11 +500,11 @@ lemma analz_subset_iff [simp]: "(analz G \ analz H) = (G \ analz H)" by (metis analz_idem analz_increasing analz_mono subset_trans) -lemma analz_trans: "\X\ analz G; G \ analz H\ \ X\ analz H" +lemma analz_trans: "\X \ analz G; G \ analz H\ \ X \ analz H" by (drule analz_mono, blast) text\Cut; Lemma 2 of Lowe\ -lemma analz_cut: "\Y\ analz (insert X H); X\ analz H\ \ Y\ analz H" +lemma analz_cut: "\Y \ analz (insert X H); X \ analz H\ \ Y \ analz H" by (erule analz_trans, blast) (*Cut can be proved easily by induction on @@ -514,7 +514,7 @@ text\This rewrite rule helps in the simplification of messages that involve the forwarding of unknown components (X). Without it, removing occurrences of X can be very complicated.\ -lemma analz_insert_eq: "X\ analz H \ analz (insert X H) = analz H" +lemma analz_insert_eq: "X \ analz H \ analz (insert X H) = analz H" by (metis analz_cut analz_insert_eq_I insert_absorb) @@ -541,16 +541,6 @@ apply (erule analz.induct, blast+) done -text\These two are obsolete (with a single Spy) but cost little to prove...\ -lemma analz_UN_analz_lemma: - "X\ analz (\i\A. analz (H i)) \ X\ analz (\i\A. H i)" - apply (erule analz.induct) - apply (blast intro: analz_mono [THEN [2] rev_subsetD])+ - done - -lemma analz_UN_analz [simp]: "analz (\i\A. analz (H i)) = analz (\i\A. H i)" - by (blast intro: analz_UN_analz_lemma analz_mono [THEN [2] rev_subsetD]) - subsection\Inductive relation "synth"\ @@ -599,7 +589,7 @@ subsubsection\Idempotence and transitivity\ -lemma synth_synthD [dest!]: "X\ synth (synth H) \ X\ synth H" +lemma synth_synthD [dest!]: "X \ synth (synth H) \ X \ synth H" by (erule synth.induct, auto) lemma synth_idem: "synth (synth H) = synth H" @@ -608,11 +598,11 @@ lemma synth_subset_iff [simp]: "(synth G \ synth H) = (G \ synth H)" by (metis subset_trans synth_idem synth_increasing synth_mono) -lemma synth_trans: "\X\ synth G; G \ synth H\ \ X\ synth H" +lemma synth_trans: "\X \ synth G; G \ synth H\ \ X \ synth H" by (drule synth_mono, blast) text\Cut; Lemma 2 of Lowe\ -lemma synth_cut: "\Y\ synth (insert X H); X\ synth H\ \ Y\ synth H" +lemma synth_cut: "\Y \ synth (insert X H); X \ synth H\ \ Y \ synth H" by (erule synth_trans, blast) lemma Crypt_synth_eq [simp]: @@ -628,25 +618,23 @@ subsubsection\Combinations of parts, analz and synth\ lemma parts_synth [simp]: "parts (synth H) = parts H \ synth H" - apply (rule equalityI) - apply (rule subsetI) - apply (erule parts.induct) - apply (blast intro: synth_increasing [THEN parts_mono, THEN subsetD] - parts.Fst parts.Snd parts.Body)+ - done +proof - + have "X \ parts (synth H) \ X \ parts H \ synth H" for X + by (induction X rule: parts.induct) (auto intro: parts.intros) + then show ?thesis + by (meson parts_increasing parts_mono subsetI antisym sup_least synth_increasing) +qed lemma analz_analz_Un [simp]: "analz (analz G \ H) = analz (G \ H)" - apply (intro equalityI analz_subset_cong)+ - apply simp_all - done + using analz_cong by blast lemma analz_synth_Un [simp]: "analz (synth G \ H) = analz (G \ H) \ synth G" - apply (rule equalityI) - apply (rule subsetI) - apply (erule analz.induct) - prefer 5 apply (blast intro: analz_mono [THEN [2] rev_subsetD]) - apply (blast intro: analz.Fst analz.Snd analz.Decrypt)+ - done +proof - + have "X \ analz (synth G \ H) \ X \ analz (G \ H) \ synth G" for X + by (induction X rule: analz.induct) (auto intro: analz.intros) + then show ?thesis + by (metis analz_subset_iff le_sup_iff subsetI subset_antisym synth_subset_iff) +qed lemma analz_synth [simp]: "analz (synth H) = analz H \ synth H" by (metis Un_empty_right analz_synth_Un) @@ -654,7 +642,7 @@ subsubsection\For reasoning about the Fake rule in traces\ -lemma parts_insert_subset_Un: "X\ G \ parts(insert X H) \ parts G \ parts H" +lemma parts_insert_subset_Un: "X \ G \ parts(insert X H) \ parts G \ parts H" by (metis UnCI Un_upper2 insert_subset parts_Un parts_mono) text\More specifically for Fake. See also \Fake_parts_sing\ below\ @@ -672,7 +660,7 @@ text\\<^term>\H\ is sometimes \<^term>\Key ` KK \ spies evs\, so can't put \<^term>\G=H\.\ lemma Fake_analz_insert: - "X\ synth (analz G) \ + "X \ synth (analz G) \ analz (insert X H) \ synth (analz G) \ analz (G \ H)" by (metis UnCI Un_commute Un_upper1 analz_analz_Un analz_mono analz_synth_Un insert_subset) diff -r b45c8e35231e -r e4fa45571bab src/HOL/SET_Protocol/Message_SET.thy --- a/src/HOL/SET_Protocol/Message_SET.thy Tue Oct 18 15:59:15 2022 +0100 +++ b/src/HOL/SET_Protocol/Message_SET.thy Wed Oct 19 13:39:00 2022 +0100 @@ -19,9 +19,9 @@ by blast text\Collapses redundant cases in the huge protocol proofs\ -lemmas disj_simps = disj_comms disj_left_absorb disj_assoc +lemmas disj_simps = disj_comms disj_left_absorb disj_assoc -text\Effective with assumptions like \<^term>\K \ range pubK\ and +text\Effective with assumptions like \<^term>\K \ range pubK\ and \<^term>\K \ invKey`range pubK\\ lemma notin_image_iff: "(y \ f`I) = (\i\I. f i \ y)" by blast @@ -85,7 +85,7 @@ text\The function is indeed injective\ lemma inj_nat_of_agent: "inj nat_of_agent" -by (simp add: nat_of_agent_def inj_on_def curry_def prod_encode_eq split: agent.split) +by (simp add: nat_of_agent_def inj_on_def curry_def prod_encode_eq split: agent.split) definition @@ -620,16 +620,6 @@ apply (erule analz.induct, blast+) done -(*These two are obsolete (with a single Spy) but cost little to prove...*) -lemma analz_UN_analz_lemma: - "X\ analz (\i\A. analz (H i)) ==> X\ analz (\i\A. H i)" -apply (erule analz.induct) -apply (blast intro: analz_mono [THEN [2] rev_subsetD])+ -done - -lemma analz_UN_analz [simp]: "analz (\i\A. analz (H i)) = analz (\i\A. H i)" -by (blast intro: analz_UN_analz_lemma analz_mono [THEN [2] rev_subsetD]) - subsection\Inductive relation "synth"\ @@ -760,7 +750,7 @@ done lemma Fake_parts_insert_in_Un: - "[|Z \ parts (insert X H); X \ synth (analz H)|] + "[|Z \ parts (insert X H); X \ synth (analz H)|] ==> Z \ synth (analz H) \ parts H" by (blast dest: Fake_parts_insert [THEN subsetD, dest])