src/Pure/more_thm.ML
changeset 74232 1091880266e5
parent 74230 d637611b41bd
child 74235 dbaed92fd8af
equal deleted inserted replaced
74231:b3c65c984210 74232:1091880266e5
   406   | instantiate_frees (instT, inst) th =
   406   | instantiate_frees (instT, inst) th =
   407       let
   407       let
   408         val idx = Thm.maxidx_of th + 1;
   408         val idx = Thm.maxidx_of th + 1;
   409         fun index ((a, A), b) = (((a, idx), A), b);
   409         fun index ((a, A), b) = (((a, idx), A), b);
   410         val insts = (map index instT, map index inst);
   410         val insts = (map index instT, map index inst);
   411         val tfrees = fold (Symtab.insert_set o #1 o #1) instT Symtab.empty;
   411         val tfrees = Symtab.build (fold (Symtab.insert_set o #1 o #1) instT);
   412         val frees = fold (Symtab.insert_set o #1 o #1) inst Symtab.empty;
   412         val frees = Symtab.build (fold (Symtab.insert_set o #1 o #1) inst);
   413 
   413 
   414         val hyps = Thm.chyps_of th;
   414         val hyps = Thm.chyps_of th;
   415         val inst_cterm =
   415         val inst_cterm =
   416           Thm.generalize_cterm (tfrees, frees) idx #>
   416           Thm.generalize_cterm (tfrees, frees) idx #>
   417           Thm.instantiate_cterm insts;
   417           Thm.instantiate_cterm insts;
   447 (* forall_intr_frees: generalization over all suitable Free variables *)
   447 (* forall_intr_frees: generalization over all suitable Free variables *)
   448 
   448 
   449 fun forall_intr_frees th =
   449 fun forall_intr_frees th =
   450   let
   450   let
   451     val fixed =
   451     val fixed =
   452       Term_Subst.Frees.empty
   452       Term_Subst.Frees.build
   453       |> fold Term_Subst.add_frees (Thm.terms_of_tpairs (Thm.tpairs_of th))
   453        (fold Term_Subst.add_frees (Thm.terms_of_tpairs (Thm.tpairs_of th)) #>
   454       |> fold Term_Subst.add_frees (Thm.hyps_of th);
   454         fold Term_Subst.add_frees (Thm.hyps_of th));
   455     val frees =
   455     val frees =
   456       Thm.fold_atomic_cterms (fn a =>
   456       Thm.fold_atomic_cterms (fn a =>
   457         (case Thm.term_of a of
   457         (case Thm.term_of a of
   458           Free v => not (Term_Subst.Frees.defined fixed v) ? insert (op aconvc) a
   458           Free v => not (Term_Subst.Frees.defined fixed v) ? insert (op aconvc) a
   459         | _ => I)) th [];
   459         | _ => I)) th [];
   470 
   470 
   471     val cert = Thm.global_cterm_of thy;
   471     val cert = Thm.global_cterm_of thy;
   472     val certT = Thm.global_ctyp_of thy;
   472     val certT = Thm.global_ctyp_of thy;
   473 
   473 
   474     val instT =
   474     val instT =
   475       (prop, Term_Subst.TVars.empty) |-> (Term.fold_types o Term.fold_atyps)
   475       Term_Subst.TVars.build (prop |> (Term.fold_types o Term.fold_atyps)
   476         (fn T => fn instT =>
   476         (fn T => fn instT =>
   477           (case T of
   477           (case T of
   478             TVar (v as ((a, _), S)) =>
   478             TVar (v as ((a, _), S)) =>
   479               if Term_Subst.TVars.defined instT v then instT
   479               if Term_Subst.TVars.defined instT v then instT
   480               else Term_Subst.TVars.update (v, TFree (a, S)) instT
   480               else Term_Subst.TVars.update (v, TFree (a, S)) instT
   481           | _ => instT));
   481           | _ => instT)));
   482     val cinstT = Term_Subst.TVars.map (K certT) instT;
   482     val cinstT = Term_Subst.TVars.map (K certT) instT;
   483     val cinst =
   483     val cinst =
   484       (prop, Term_Subst.Vars.empty) |-> Term.fold_aterms
   484       Term_Subst.Vars.build (prop |> Term.fold_aterms
   485         (fn t => fn inst =>
   485         (fn t => fn inst =>
   486           (case t of
   486           (case t of
   487             Var ((x, i), T) =>
   487             Var ((x, i), T) =>
   488               let val T' = Term_Subst.instantiateT instT T
   488               let val T' = Term_Subst.instantiateT instT T
   489               in Term_Subst.Vars.update (((x, i), T'), cert (Free ((x, T')))) inst end
   489               in Term_Subst.Vars.update (((x, i), T'), cert (Free ((x, T')))) inst end
   490           | _ => inst));
   490           | _ => inst)));
   491   in Thm.instantiate (Term_Subst.TVars.dest cinstT, Term_Subst.Vars.dest cinst) th end;
   491   in Thm.instantiate (Term_Subst.TVars.dest cinstT, Term_Subst.Vars.dest cinst) th end;
   492 
   492 
   493 fun unvarify_axiom thy = unvarify_global thy o Thm.axiom thy;
   493 fun unvarify_axiom thy = unvarify_global thy o Thm.axiom thy;
   494 
   494 
   495 
   495