equal
deleted
inserted
replaced
526 fun mk_exists ctxt v th = Drule.arg_cong_rule (ext ctxt (Thm.typ_of_cterm v)) |
526 fun mk_exists ctxt v th = Drule.arg_cong_rule (ext ctxt (Thm.typ_of_cterm v)) |
527 (Thm.abstract_rule (getname v) v th) |
527 (Thm.abstract_rule (getname v) v th) |
528 fun simp_ex_conv ctxt = |
528 fun simp_ex_conv ctxt = |
529 Simplifier.rewrite (put_simpset HOL_basic_ss ctxt addsimps @{thms simp_thms(39)}) |
529 Simplifier.rewrite (put_simpset HOL_basic_ss ctxt addsimps @{thms simp_thms(39)}) |
530 |
530 |
531 fun free_in v t = member op aconvc (Misc_Legacy.cterm_frees t) v; |
531 fun free_in v t = Cterms.defined (Misc_Legacy.cterm_frees t) v; |
532 |
532 |
533 val vsubst = let |
533 val vsubst = let |
534 fun vsubst (t,v) tm = |
534 fun vsubst (t,v) tm = |
535 (Thm.rhs_of o Thm.beta_conversion false) (Thm.apply (Thm.lambda v tm) t) |
535 (Thm.rhs_of o Thm.beta_conversion false) (Thm.apply (Thm.lambda v tm) t) |
536 in fold vsubst end; |
536 in fold vsubst end; |
735 let |
735 let |
736 val T = Thm.typ_of_cterm x; |
736 val T = Thm.typ_of_cterm x; |
737 val all = Thm.cterm_of ctxt (Const (\<^const_name>\<open>All\<close>, (T --> \<^typ>\<open>bool\<close>) --> \<^typ>\<open>bool\<close>)) |
737 val all = Thm.cterm_of ctxt (Const (\<^const_name>\<open>All\<close>, (T --> \<^typ>\<open>bool\<close>) --> \<^typ>\<open>bool\<close>)) |
738 in Thm.apply all (Thm.lambda x p) end |
738 in Thm.apply all (Thm.lambda x p) end |
739 val avs = Misc_Legacy.cterm_frees tm |
739 val avs = Misc_Legacy.cterm_frees tm |
740 val P' = fold mk_forall avs tm |
740 val P' = fold mk_forall (Cterms.list_set_rev avs) tm |
741 val th1 = initial_conv ctxt (mk_neg P') |
741 val th1 = initial_conv ctxt (mk_neg P') |
742 val (evs,bod) = strip_exists(concl th1) in |
742 val (evs,bod) = strip_exists(concl th1) in |
743 if is_forall bod then raise CTERM("ring: non-universal formula",[tm]) |
743 if is_forall bod then raise CTERM("ring: non-universal formula",[tm]) |
744 else |
744 else |
745 let |
745 let |
750 val th2 = fold (fn v => fn th => (Thm.forall_intr v th) COMP allI) evs (th2b RS PFalse) |
750 val th2 = fold (fn v => fn th => (Thm.forall_intr v th) COMP allI) evs (th2b RS PFalse) |
751 val th3 = |
751 val th3 = |
752 Thm.equal_elim |
752 Thm.equal_elim |
753 (Simplifier.rewrite (put_simpset HOL_basic_ss ctxt addsimps [not_ex RS sym]) |
753 (Simplifier.rewrite (put_simpset HOL_basic_ss ctxt addsimps [not_ex RS sym]) |
754 (th2 |> Thm.cprop_of)) th2 |
754 (th2 |> Thm.cprop_of)) th2 |
755 in specl avs |
755 in specl (Cterms.list_set_rev avs) |
756 ([[[HOLogic.mk_obj_eq th1, th3 RS PFalse'] MRS trans] MRS PFalse] MRS notnotD) |
756 ([[[HOLogic.mk_obj_eq th1, th3 RS PFalse'] MRS trans] MRS PFalse] MRS notnotD) |
757 end |
757 end |
758 end |
758 end |
759 fun ideal tms tm ord = |
759 fun ideal tms tm ord = |
760 let |
760 let |
793 fun is_defined v t = |
793 fun is_defined v t = |
794 let |
794 let |
795 val mons = striplist(dest_binary ring_add_tm) t |
795 val mons = striplist(dest_binary ring_add_tm) t |
796 in member (op aconvc) mons v andalso |
796 in member (op aconvc) mons v andalso |
797 forall (fn m => v aconvc m |
797 forall (fn m => v aconvc m |
798 orelse not(member (op aconvc) (Misc_Legacy.cterm_frees m) v)) mons |
798 orelse not(Cterms.defined (Misc_Legacy.cterm_frees m) v)) mons |
799 end |
799 end |
800 |
800 |
801 fun isolate_variable vars tm = |
801 fun isolate_variable vars tm = |
802 let |
802 let |
803 val th = poly_eq_conv tm |
803 val th = poly_eq_conv tm |
848 end |
848 end |
849 |
849 |
850 fun isolate_monomials vars tm = |
850 fun isolate_monomials vars tm = |
851 let |
851 let |
852 val (cmons,vmons) = |
852 val (cmons,vmons) = |
853 List.partition (fn m => null (inter (op aconvc) vars (Misc_Legacy.cterm_frees m))) |
853 List.partition (fn m => null (inter (op aconvc) vars (Cterms.list_set_rev (Misc_Legacy.cterm_frees m)))) |
854 (striplist ring_dest_add tm) |
854 (striplist ring_dest_add tm) |
855 val cofactors = map (fn v => find_multipliers v vmons) vars |
855 val cofactors = map (fn v => find_multipliers v vmons) vars |
856 val cnc = if null cmons then zero_tm |
856 val cnc = if null cmons then zero_tm |
857 else Thm.apply ring_neg_tm |
857 else Thm.apply ring_neg_tm |
858 (list_mk_binop ring_add_tm cmons) |
858 (list_mk_binop ring_add_tm cmons) |