# HG changeset patch # User haftmann # Date 1237882559 -3600 # Node ID 182fb8d27b48656f56083e85ca27fa44d4354033 # Parent c672c8162f4b59c146fa4af5ede72edba141dfa9# Parent 4b182a031731fc2689e39e68428eef7a536dc924 merged diff -r 4b182a031731 -r 182fb8d27b48 src/HOL/OrderedGroup.thy --- a/src/HOL/OrderedGroup.thy Tue Mar 24 09:15:51 2009 +0100 +++ b/src/HOL/OrderedGroup.thy Tue Mar 24 09:15:59 2009 +0100 @@ -466,7 +466,7 @@ then show ?thesis by simp qed -lemma add_neg_nonpos: +lemma add_neg_nonpos: assumes "a < 0" and "b \ 0" shows "a + b < 0" proof - have "a + b < 0 + 0" @@ -494,6 +494,10 @@ then show ?thesis by simp qed +lemmas add_sign_intros = + add_pos_nonneg add_pos_pos add_nonneg_pos add_nonneg_nonneg + add_neg_nonpos add_neg_neg add_nonpos_neg add_nonpos_nonpos + lemma add_nonneg_eq_0_iff: assumes x: "0 \ x" and y: "0 \ y" shows "x + y = 0 \ x = 0 \ y = 0" diff -r 4b182a031731 -r 182fb8d27b48 src/HOL/Ring_and_Field.thy --- a/src/HOL/Ring_and_Field.thy Tue Mar 24 09:15:51 2009 +0100 +++ b/src/HOL/Ring_and_Field.thy Tue Mar 24 09:15:59 2009 +0100 @@ -729,11 +729,15 @@ subclass pordered_semiring .. lemma mult_nonneg_nonneg: "0 \ a \ 0 \ b \ 0 \ a * b" -by (drule mult_left_mono [of zero b], auto) +using mult_left_mono [of zero b a] by simp lemma mult_nonneg_nonpos: "0 \ a \ b \ 0 \ a * b \ 0" -by (drule mult_left_mono [of b zero], auto) - +using mult_left_mono [of b zero a] by simp + +lemma mult_nonpos_nonneg: "a \ 0 \ 0 \ b \ a * b \ 0" +using mult_right_mono [of a zero b] by simp + +text {* Legacy - use @{text mult_nonpos_nonneg} *} lemma mult_nonneg_nonpos2: "0 \ a \ b \ 0 \ b * a \ 0" by (drule mult_right_mono [of b zero], auto) @@ -786,31 +790,32 @@ "a * c \ b * c \ 0 < c \ a \ b" by (force simp add: mult_strict_right_mono not_less [symmetric]) -lemma mult_pos_pos: - "0 < a \ 0 < b \ 0 < a * b" -by (drule mult_strict_left_mono [of zero b], auto) - -lemma mult_pos_neg: - "0 < a \ b < 0 \ a * b < 0" -by (drule mult_strict_left_mono [of b zero], auto) - -lemma mult_pos_neg2: - "0 < a \ b < 0 \ b * a < 0" +lemma mult_pos_pos: "0 < a \ 0 < b \ 0 < a * b" +using mult_strict_left_mono [of zero b a] by simp + +lemma mult_pos_neg: "0 < a \ b < 0 \ a * b < 0" +using mult_strict_left_mono [of b zero a] by simp + +lemma mult_neg_pos: "a < 0 \ 0 < b \ a * b < 0" +using mult_strict_right_mono [of a zero b] by simp + +text {* Legacy - use @{text mult_neg_pos} *} +lemma mult_pos_neg2: "0 < a \ b < 0 \ b * a < 0" by (drule mult_strict_right_mono [of b zero], auto) lemma zero_less_mult_pos: "0 < a * b \ 0 < a \ 0 < b" -apply (cases "b\0") +apply (cases "b\0") apply (auto simp add: le_less not_less) -apply (drule_tac mult_pos_neg [of a b]) +apply (drule_tac mult_pos_neg [of a b]) apply (auto dest: less_not_sym) done lemma zero_less_mult_pos2: "0 < b * a \ 0 < a \ 0 < b" -apply (cases "b\0") +apply (cases "b\0") apply (auto simp add: le_less not_less) -apply (drule_tac mult_pos_neg2 [of a b]) +apply (drule_tac mult_pos_neg2 [of a b]) apply (auto dest: less_not_sym) done @@ -819,9 +824,9 @@ assumes "a < b" and "c < d" and "0 < b" and "0 \ c" shows "a * c < b * d" using assms apply (cases "c=0") - apply (simp add: mult_pos_pos) + apply (simp add: mult_pos_pos) apply (erule mult_strict_right_mono [THEN less_trans]) - apply (force simp add: le_less) + apply (force simp add: le_less) apply (erule mult_strict_left_mono, assumption) done @@ -960,9 +965,8 @@ apply (simp_all add: minus_mult_right [symmetric]) done -lemma mult_nonpos_nonpos: - "a \ 0 \ b \ 0 \ 0 \ a * b" -by (drule mult_right_mono_neg [of a zero b]) auto +lemma mult_nonpos_nonpos: "a \ 0 \ b \ 0 \ 0 \ a * b" +using mult_right_mono_neg [of a zero b] by simp lemma split_mult_pos_le: "(0 \ a \ 0 \ b) \ (a \ 0 \ b \ 0) \ 0 \ a * b" @@ -1006,21 +1010,14 @@ subclass ordered_ring .. -lemma mult_strict_left_mono_neg: - "b < a \ c < 0 \ c * a < c * b" - apply (drule mult_strict_left_mono [of _ _ "uminus c"]) - apply (simp_all add: minus_mult_left [symmetric]) - done - -lemma mult_strict_right_mono_neg: - "b < a \ c < 0 \ a * c < b * c" - apply (drule mult_strict_right_mono [of _ _ "uminus c"]) - apply (simp_all add: minus_mult_right [symmetric]) - done - -lemma mult_neg_neg: - "a < 0 \ b < 0 \ 0 < a * b" -by (drule mult_strict_right_mono_neg, auto) +lemma mult_strict_left_mono_neg: "b < a \ c < 0 \ c * a < c * b" +using mult_strict_left_mono [of b a "- c"] by simp + +lemma mult_strict_right_mono_neg: "b < a \ c < 0 \ a * c < b * c" +using mult_strict_right_mono [of b a "- c"] by simp + +lemma mult_neg_neg: "a < 0 \ b < 0 \ 0 < a * b" +using mult_strict_right_mono_neg [of a zero b] by simp subclass ring_no_zero_divisors proof @@ -1144,11 +1141,6 @@ "c < 0 \ c * a \ c * b \ b \ a" by (auto simp: mult_le_cancel_left) -end - -context ordered_ring_strict -begin - lemma mult_less_cancel_left_pos: "0 < c \ c * a < c * b \ a < b" by (auto simp: mult_less_cancel_left) @@ -1162,6 +1154,11 @@ text{*Legacy - use @{text algebra_simps} *} lemmas ring_simps[noatp] = algebra_simps +lemmas mult_sign_intros = + mult_nonneg_nonneg mult_nonneg_nonpos + mult_nonpos_nonneg mult_nonpos_nonpos + mult_pos_pos mult_pos_neg + mult_neg_pos mult_neg_neg class pordered_comm_ring = comm_ring + pordered_comm_semiring begin diff -r 4b182a031731 -r 182fb8d27b48 src/Pure/Tools/find_theorems.ML --- a/src/Pure/Tools/find_theorems.ML Tue Mar 24 09:15:51 2009 +0100 +++ b/src/Pure/Tools/find_theorems.ML Tue Mar 24 09:15:59 2009 +0100 @@ -336,7 +336,9 @@ fun find_theorems ctxt opt_goal rem_dups raw_criteria = let - val add_prems = Seq.hd o (TRY (Method.insert_tac (Assumption.all_prems_of ctxt) 1)); + val assms = ProofContext.get_fact ctxt (Facts.named "local.assms") + handle ERROR _ => []; + val add_prems = Seq.hd o (TRY (Method.insert_tac assms 1)); val opt_goal' = Option.map add_prems opt_goal; val criteria = map (apsnd (read_criterion ctxt)) raw_criteria;