src/Pure/Isar/proof_context.ML
changeset 19847 28724aab4745
parent 19733 12f095315a42
child 19867 474cc9b49239
equal deleted inserted replaced
19846:3a2d33a5a7b6 19847:28724aab4745
    77   val warn_extra_tfrees: context -> context -> context
    77   val warn_extra_tfrees: context -> context -> context
    78   val generalize: context -> context -> term list -> term list
    78   val generalize: context -> context -> term list -> term list
    79   val monomorphic: context -> term list -> term list
    79   val monomorphic: context -> term list -> term list
    80   val polymorphic: context -> term list -> term list
    80   val polymorphic: context -> term list -> term list
    81   val hidden_polymorphism: term -> typ -> (indexname * sort) list
    81   val hidden_polymorphism: term -> typ -> (indexname * sort) list
       
    82   val goal_exports: context -> context -> thm -> thm Seq.seq
       
    83   val exports: context -> context -> thm -> thm Seq.seq
       
    84   val export: context -> context -> thm -> thm
    82   val export_standard: context -> context -> thm -> thm
    85   val export_standard: context -> context -> thm -> thm
    83   val exports: context -> context -> thm -> thm Seq.seq
       
    84   val goal_exports: context -> context -> thm -> thm Seq.seq
       
    85   val drop_schematic: indexname * term option -> indexname * term option
    86   val drop_schematic: indexname * term option -> indexname * term option
    86   val add_binds: (indexname * string option) list -> context -> context
    87   val add_binds: (indexname * string option) list -> context -> context
    87   val add_binds_i: (indexname * term option) list -> context -> context
    88   val add_binds_i: (indexname * term option) list -> context -> context
    88   val auto_bind_goal: term list -> context -> context
    89   val auto_bind_goal: term list -> context -> context
    89   val auto_bind_facts: term list -> context -> context
    90   val auto_bind_facts: term list -> context -> context
   139   val add_fixes_legacy: (string * typ option * mixfix) list -> context -> string list * context
   140   val add_fixes_legacy: (string * typ option * mixfix) list -> context -> string list * context
   140   val invent_fixes: string list -> context -> string list * context
   141   val invent_fixes: string list -> context -> string list * context
   141   val fix_frees: term -> context -> context
   142   val fix_frees: term -> context -> context
   142   val auto_fixes: context * (term list list * 'a) -> context * (term list list * 'a)
   143   val auto_fixes: context * (term list list * 'a) -> context * (term list list * 'a)
   143   val bind_fixes: string list -> context -> (term -> term) * context
   144   val bind_fixes: string list -> context -> (term -> term) * context
       
   145   val import: bool -> thm list -> context -> thm list * context
   144   val add_assms: export ->
   146   val add_assms: export ->
   145     ((string * attribute list) * (string * string list) list) list ->
   147     ((string * attribute list) * (string * string list) list) list ->
   146     context -> (bstring * thm list) list * context
   148     context -> (bstring * thm list) list * context
   147   val add_assms_i: export ->
   149   val add_assms_i: export ->
   148     ((string * attribute list) * (term * term list) list) list ->
   150     ((string * attribute list) * (term * term list) list) list ->
   790         |> Goal.norm_hhf_protect
   792         |> Goal.norm_hhf_protect
   791         |> Drule.tvars_intr_list tfrees |> #2
   793         |> Drule.tvars_intr_list tfrees |> #2
   792       end)
   794       end)
   793   end;
   795   end;
   794 
   796 
   795 fun export_standard inner outer =
   797 val goal_exports = common_exports true;
       
   798 val exports = common_exports false;
       
   799 
       
   800 fun export inner outer =
   796   let val exp = common_exports false inner outer in
   801   let val exp = common_exports false inner outer in
   797     fn th =>
   802     fn th =>
   798       (case Seq.pull (exp th) of
   803       (case Seq.pull (exp th) of
   799         SOME (th', _) => th' |> Drule.local_standard
   804         SOME (th', _) => th'
   800       | NONE => sys_error "Failed to export theorem")
   805       | NONE => raise THM ("Failed to export theorem", 0, [th]))
   801   end;
   806   end;
   802 
   807 
   803 val exports = common_exports false;
   808 fun export_standard inner outer =
   804 val goal_exports = common_exports true;
   809   export inner outer #> Drule.local_standard;
   805 
   810 
   806 
   811 
   807 
   812 
   808 (** bindings **)
   813 (** bindings **)
   809 
   814 
  1230       | bind (Abs (x, T, t)) = Abs (x, T, bind t)
  1235       | bind (Abs (x, T, t)) = Abs (x, T, bind t)
  1231       | bind a = a;
  1236       | bind a = a;
  1232   in (bind, ctxt') end;
  1237   in (bind, ctxt') end;
  1233 
  1238 
  1234 
  1239 
       
  1240 (* import -- fixes schematic variables *)
       
  1241 
       
  1242 fun import is_open ths ctxt =
       
  1243   let
       
  1244     val rename = if is_open then I else Syntax.internal;
       
  1245     val thy = theory_of ctxt;
       
  1246     val cert = Thm.cterm_of thy;
       
  1247     val certT = Thm.ctyp_of thy;
       
  1248 
       
  1249     val tvars = rev (fold (Term.add_tvars o Thm.full_prop_of) ths []);
       
  1250     val tfrees =
       
  1251       map TFree (Term.invent_names (used_types ctxt) "'a" (length tvars) ~~ map #2 tvars);
       
  1252     val vars =
       
  1253       rev (fold (Term.add_vars o Thm.full_prop_of) ths [])
       
  1254       |> map (apsnd (Term.instantiateT (tvars ~~ tfrees)));
       
  1255 
       
  1256     val (xs, ctxt') = ctxt
       
  1257       |> fold (declare_term o Logic.mk_type) tfrees
       
  1258       |> invent_fixes (Term.variantlist (map (rename o #1 o #1) vars, []));
       
  1259 
       
  1260     val instT = map (certT o TVar) tvars ~~ map certT tfrees;
       
  1261     val inst = map (cert o Var) vars ~~ map (cert o Free) (xs ~~ map #2 vars);
       
  1262   in (map (Thm.instantiate (instT, inst)) ths, ctxt') end;
       
  1263 
       
  1264 
  1235 
  1265 
  1236 (** assumptions **)
  1266 (** assumptions **)
  1237 
  1267 
  1238 (* generic assms *)
  1268 (* generic assms *)
  1239 
  1269