src/Pure/Isar/isar_thy.ML
changeset 17000 552df70f52c2
parent 16849 a6cdb1ade955
child 17034 b4d9b87c102e
equal deleted inserted replaced
16999:307b2ec590ff 17000:552df70f52c2
   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