657 end; |
657 end; |
658 |
658 |
659 fun register_in_locale (target, expr) int thy = |
659 fun register_in_locale (target, expr) int thy = |
660 let |
660 let |
661 val target = Locale.intern thy target; |
661 val target = Locale.intern thy target; |
|
662 val (target_expr, thy', propss, activate) = |
|
663 Locale.prep_registration_in_locale target expr thy; |
|
664 fun witness id (thy, thm) = let |
|
665 (* push outer quantifiers inside implications *) |
|
666 val {prop, sign, ...} = rep_thm thm; |
|
667 val frees = map (cterm_of sign o Free) (strip_all_vars prop); |
|
668 (* are hopefully distinct *) |
|
669 val prems = Logic.strip_imp_prems (strip_all_body prop); |
|
670 val cprems = map (cterm_of sign) prems; |
|
671 val thm' = thm |> forall_elim_list frees |
|
672 |> (fn th => implies_elim_list th (map Thm.assume cprems)) |
|
673 |> forall_intr_list frees; |
|
674 in (Locale.add_witness_in_locale target id thm' thy, thm') end; |
662 in |
675 in |
663 locale_multi_theorem_i Drule.internalK target ("",[]) [] |
676 multi_theorem_i Drule.internalK activate ProofContext.export_plain |
664 [] (*concl*) int thy |
677 ("",[]) [Locale.Expr target_expr] |
|
678 (map (fn (id as (n, _), props) => ((NameSpace.base n, [witness id]), |
|
679 map (fn prop => (prop, ([], []))) props)) propss) int thy' |
665 end; |
680 end; |
666 |
681 |
667 fun register_locally (((prfx, atts), expr), insts) = |
682 fun register_locally (((prfx, atts), expr), insts) = |
668 ProofHistory.apply (fn state => |
683 ProofHistory.apply (fn state => |
669 let |
684 let |