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 |