# HG changeset patch # User huffman # Date 1118182706 -7200 # Node ID 868eddbcaf6e5cc2fca78551b542c67dcd16728f # Parent 17db5df51a3544adbcfc86ddf630bedc9d1f8140 added theorems less_sprod, spair_less, spair_eq, spair_inject diff -r 17db5df51a35 -r 868eddbcaf6e src/HOLCF/Sprod.ML --- a/src/HOLCF/Sprod.ML Wed Jun 08 00:16:28 2005 +0200 +++ b/src/HOLCF/Sprod.ML Wed Jun 08 00:18:26 2005 +0200 @@ -6,7 +6,6 @@ val sfst_def = thm "sfst_def"; val ssnd_def = thm "ssnd_def"; val ssplit_def = thm "ssplit_def"; -val spair_inject = thm "spair_inject"; val inst_sprod_pcpo2 = thm "inst_sprod_pcpo2"; val spair_strict = thm "spair_strict"; val spair_strict1 = thm "spair_strict1"; @@ -14,6 +13,8 @@ val spair_strict_rev = thm "spair_strict_rev"; val spair_defined_rev = thm "spair_defined_rev"; val spair_defined = thm "spair_defined"; +val spair_eq = thm "spair_eq"; +val spair_inject = thm "spair_inject"; val Exh_Sprod2 = thm "Exh_Sprod2"; val sprodE = thm "sprodE"; val sfst_strict = thm "sfst_strict"; @@ -22,6 +23,8 @@ val ssnd_spair = thm "ssnd_spair"; val sfstssnd_defined = thm "sfstssnd_defined"; val surjective_pairing_Sprod2 = thm "surjective_pairing_Sprod2"; +val less_sprod = thm "less_sprod"; +val spair_less = thm "spair_less"; val ssplit1 = thm "ssplit1"; val ssplit2 = thm "ssplit2"; val ssplit3 = thm "ssplit3"; diff -r 17db5df51a35 -r 868eddbcaf6e src/HOLCF/Sprod.thy --- a/src/HOLCF/Sprod.thy Wed Jun 08 00:16:28 2005 +0200 +++ b/src/HOLCF/Sprod.thy Wed Jun 08 00:18:26 2005 +0200 @@ -113,20 +113,20 @@ subsection {* Properties of @{term spair} *} -lemma spair_strict1 [simp]: "(:\, b:) = \" +lemma spair_strict1 [simp]: "(:\, y:) = \" by (simp add: spair_Abs_Sprod UU_Abs_Sprod strictify_conv_if) -lemma spair_strict2 [simp]: "(:a, \:) = \" +lemma spair_strict2 [simp]: "(:x, \:) = \" by (simp add: spair_Abs_Sprod UU_Abs_Sprod strictify_conv_if) -lemma spair_strict: "a = \ \ b = \ \ (:a, b:) = \" +lemma spair_strict: "x = \ \ y = \ \ (:x, y:) = \" by auto lemma spair_strict_rev: "(:x, y:) \ \ \ x \ \ \ y \ \" by (erule contrapos_np, auto) lemma spair_defined [simp]: - "\a \ \; b \ \\ \ (:a, b:) \ \" + "\x \ \; y \ \\ \ (:x, y:) \ \" apply (simp add: spair_Abs_Sprod UU_Abs_Sprod) apply (subst Abs_Sprod_inject) apply (simp add: Sprod_def) @@ -134,15 +134,19 @@ apply simp done -lemma spair_defined_rev: "(:a, b:) = \ \ a = \ \ b = \" +lemma spair_defined_rev: "(:x, y:) = \ \ x = \ \ y = \" by (erule contrapos_pp, simp) +lemma spair_eq: + "\x \ \; y \ \\ \ ((:x, y:) = (:a, b:)) = (x = a \ y = b)" +apply (simp add: spair_Abs_Sprod) +apply (simp add: Abs_Sprod_inject [OF _ spair_lemma] Sprod_def) +apply (simp add: strictify_conv_if) +done + lemma spair_inject: - "\aa \ \; ba \ \; (:a,b:) = (:aa,ba:)\ \ a = aa \ b = ba" -apply (simp add: spair_Abs_Sprod) -apply (simp add: Abs_Sprod_inject [OF spair_lemma] Sprod_def) -apply (simp add: strictify_conv_if split: split_if_asm) -done + "\x \ \; y \ \; (:x, y:) = (:a, b:)\ \ x = a \ y = b" +by (rule spair_eq [THEN iffD1]) lemma inst_sprod_pcpo2: "UU = (:UU,UU:)" by simp @@ -169,10 +173,25 @@ lemma sfstssnd_defined: "p \ \ \ sfst\p \ \ \ ssnd\p \ \" by (rule_tac p=p in sprodE, simp_all) - + lemma surjective_pairing_Sprod2: "(:sfst\p, ssnd\p:) = p" by (rule_tac p=p in sprodE, simp_all) +lemma less_sprod: "p1 \ p2 = (sfst\p1 \ sfst\p2 \ ssnd\p1 \ ssnd\p2)" +apply (simp add: less_sprod_def sfst_def ssnd_def cont_Rep_Sprod) +apply (rule less_cprod) +done + +lemma spair_less: + "\x \ \; y \ \\ \ (:x, y:) \ (:a, b:) = (x \ a \ y \ b)" +apply (case_tac "a = \") +apply (simp add: eq_UU_iff [symmetric]) +apply (case_tac "b = \") +apply (simp add: eq_UU_iff [symmetric]) +apply (simp add: less_sprod) +done + + subsection {* Properties of @{term ssplit} *} lemma ssplit1 [simp]: "ssplit\f\\ = \"