202 val weak_dnf_simps = |
202 val weak_dnf_simps = |
203 List.take (simp_thms, 34) @ |
203 List.take (simp_thms, 34) @ |
204 @{lemma "((P & (Q | R)) = ((P&Q) | (P&R)))" and "((Q | R) & P) = ((Q&P) | (R&P))" and |
204 @{lemma "((P & (Q | R)) = ((P&Q) | (P&R)))" and "((Q | R) & P) = ((Q&P) | (R&P))" and |
205 "(P & Q) = (Q & P)" and "((P | Q) = (Q | P))" by blast+}; |
205 "(P & Q) = (Q & P)" and "((P | Q) = (Q | P))" by blast+}; |
206 |
206 |
|
207 (* |
207 val nnfD_simps = |
208 val nnfD_simps = |
208 @{lemma "((~(P & Q)) = (~P | ~Q))" and "((~(P | Q)) = (~P & ~Q) )" and |
209 @{lemma "((~(P & Q)) = (~P | ~Q))" and "((~(P | Q)) = (~P & ~Q) )" and |
209 "((P --> Q) = (~P | Q) )" and "((P = Q) = ((P & Q) | (~P & ~ Q)))" and |
210 "((P --> Q) = (~P | Q) )" and "((P = Q) = ((P & Q) | (~P & ~ Q)))" and |
210 "((~(P = Q)) = ((P & ~ Q) | (~P & Q)) )" and "((~ ~(P)) = P)" by blast+}; |
211 "((~(P = Q)) = ((P & ~ Q) | (~P & Q)) )" and "((~ ~(P)) = P)" by blast+}; |
|
212 *) |
211 |
213 |
212 val choice_iff = @{lemma "(ALL x. EX y. P x y) = (EX f. ALL x. P x (f x))" by metis}; |
214 val choice_iff = @{lemma "(ALL x. EX y. P x y) = (EX f. ALL x. P x (f x))" by metis}; |
213 val prenex_simps = |
215 val prenex_simps = |
214 map (fn th => th RS sym) |
216 map (fn th => th RS sym) |
215 ([@{thm "all_conj_distrib"}, @{thm "ex_disj_distrib"}] @ |
217 ([@{thm "all_conj_distrib"}, @{thm "ex_disj_distrib"}] @ |
291 fun dest_ratconst t = case term_of t of |
293 fun dest_ratconst t = case term_of t of |
292 Const(@{const_name divide}, _)$a$b => Rat.rat_of_quotient(HOLogic.dest_number a |> snd, HOLogic.dest_number b |> snd) |
294 Const(@{const_name divide}, _)$a$b => Rat.rat_of_quotient(HOLogic.dest_number a |> snd, HOLogic.dest_number b |> snd) |
293 | _ => Rat.rat_of_int (HOLogic.dest_number (term_of t) |> snd) |
295 | _ => Rat.rat_of_int (HOLogic.dest_number (term_of t) |> snd) |
294 fun is_ratconst t = can dest_ratconst t |
296 fun is_ratconst t = can dest_ratconst t |
295 |
297 |
|
298 (* |
296 fun find_term p t = if p t then t else |
299 fun find_term p t = if p t then t else |
297 case t of |
300 case t of |
298 a$b => (find_term p a handle TERM _ => find_term p b) |
301 a$b => (find_term p a handle TERM _ => find_term p b) |
299 | Abs (_,_,t') => find_term p t' |
302 | Abs (_,_,t') => find_term p t' |
300 | _ => raise TERM ("find_term",[t]); |
303 | _ => raise TERM ("find_term",[t]); |
|
304 *) |
301 |
305 |
302 fun find_cterm p t = if p t then t else |
306 fun find_cterm p t = if p t then t else |
303 case term_of t of |
307 case term_of t of |
304 a$b => (find_cterm p (Thm.dest_fun t) handle CTERM _ => find_cterm p (Thm.dest_arg t)) |
308 _$_ => (find_cterm p (Thm.dest_fun t) handle CTERM _ => find_cterm p (Thm.dest_arg t)) |
305 | Abs (_,_,t') => find_cterm p (Thm.dest_abs NONE t |> snd) |
309 | Abs (_,_,_) => find_cterm p (Thm.dest_abs NONE t |> snd) |
306 | _ => raise CTERM ("find_cterm",[t]); |
310 | _ => raise CTERM ("find_cterm",[t]); |
307 |
311 |
308 (* Some conversions-related stuff which has been forbidden entrance into Pure/conv.ML*) |
312 (* Some conversions-related stuff which has been forbidden entrance into Pure/conv.ML*) |
309 fun instantiate_cterm' ty tms = Drule.cterm_rule (Drule.instantiate' ty tms) |
313 fun instantiate_cterm' ty tms = Drule.cterm_rule (Drule.instantiate' ty tms) |
310 fun is_comb t = case (term_of t) of _$_ => true | _ => false; |
314 fun is_comb t = case (term_of t) of _$_ => true | _ => false; |
723 (* An instance for reals*) |
727 (* An instance for reals*) |
724 |
728 |
725 fun gen_prover_real_arith ctxt prover = |
729 fun gen_prover_real_arith ctxt prover = |
726 let |
730 let |
727 fun simple_cterm_ord t u = Term_Ord.term_ord (term_of t, term_of u) = LESS |
731 fun simple_cterm_ord t u = Term_Ord.term_ord (term_of t, term_of u) = LESS |
728 val {add,mul,neg,pow,sub,main} = |
732 val {add, mul, neg, pow = _, sub = _, main} = |
729 Semiring_Normalizer.semiring_normalizers_ord_wrapper ctxt |
733 Semiring_Normalizer.semiring_normalizers_ord_wrapper ctxt |
730 (the (Semiring_Normalizer.match ctxt @{cterm "(0::real) + 1"})) |
734 (the (Semiring_Normalizer.match ctxt @{cterm "(0::real) + 1"})) |
731 simple_cterm_ord |
735 simple_cterm_ord |
732 in gen_real_arith ctxt |
736 in gen_real_arith ctxt |
733 (cterm_of_rat, Numeral_Simprocs.field_comp_conv, Numeral_Simprocs.field_comp_conv, Numeral_Simprocs.field_comp_conv, |
737 (cterm_of_rat, Numeral_Simprocs.field_comp_conv, Numeral_Simprocs.field_comp_conv, Numeral_Simprocs.field_comp_conv, |