src/Pure/more_thm.ML
changeset 32279 e40563627419
parent 32198 9bdd47909ea8
child 32842 98702c579ad0
equal deleted inserted replaced
32278:f73d48f5218b 32279:e40563627419
    39   val intro_rules: thm Item_Net.T
    39   val intro_rules: thm Item_Net.T
    40   val elim_rules: thm Item_Net.T
    40   val elim_rules: thm Item_Net.T
    41   val elim_implies: thm -> thm -> thm
    41   val elim_implies: thm -> thm -> thm
    42   val forall_elim_var: int -> thm -> thm
    42   val forall_elim_var: int -> thm -> thm
    43   val forall_elim_vars: int -> thm -> thm
    43   val forall_elim_vars: int -> thm -> thm
       
    44   val certify_inst: theory ->
       
    45     ((indexname * sort) * typ) list * ((indexname * typ) * term) list ->
       
    46     (ctyp * ctyp) list * (cterm * cterm) list
       
    47   val certify_instantiate:
       
    48     ((indexname * sort) * typ) list * ((indexname * typ) * term) list -> thm -> thm
    44   val unvarify: thm -> thm
    49   val unvarify: thm -> thm
    45   val close_derivation: thm -> thm
    50   val close_derivation: thm -> thm
    46   val add_axiom: binding * term -> theory -> thm * theory
    51   val add_axiom: binding * term -> theory -> thm * theory
    47   val add_def: bool -> bool -> binding * term -> theory -> thm * theory
    52   val add_def: bool -> bool -> binding * term -> theory -> thm * theory
    48   type binding = binding * attribute list
    53   type binding = binding * attribute list
   267   | _ => raise THM ("forall_elim_vars", i, [th])) i th;
   272   | _ => raise THM ("forall_elim_vars", i, [th])) i th;
   268 
   273 
   269 end;
   274 end;
   270 
   275 
   271 
   276 
       
   277 (* certify_instantiate *)
       
   278 
       
   279 fun certify_inst thy (instT, inst) =
       
   280   (map (fn (v, T) => (Thm.ctyp_of thy (TVar v), Thm.ctyp_of thy T)) instT,
       
   281     map (fn (v, t) => (Thm.cterm_of thy (Var v), Thm.cterm_of thy t)) inst);
       
   282 
       
   283 fun certify_instantiate insts th =
       
   284   Thm.instantiate (certify_inst (Thm.theory_of_thm th) insts) th;
       
   285 
       
   286 
   272 (* unvarify: global schematic variables *)
   287 (* unvarify: global schematic variables *)
   273 
   288 
   274 fun unvarify th =
   289 fun unvarify th =
   275   let
   290   let
   276     val thy = Thm.theory_of_thm th;
       
   277     val cert = Thm.cterm_of thy;
       
   278     val certT = Thm.ctyp_of thy;
       
   279 
       
   280     val prop = Thm.full_prop_of th;
   291     val prop = Thm.full_prop_of th;
   281     val _ = map Logic.unvarify (prop :: Thm.hyps_of th)
   292     val _ = map Logic.unvarify (prop :: Thm.hyps_of th)
   282       handle TERM (msg, _) => raise THM (msg, 0, [th]);
   293       handle TERM (msg, _) => raise THM (msg, 0, [th]);
   283 
   294 
   284     val instT0 = rev (Term.add_tvars prop []) |> map (fn v as ((a, _), S) => (v, TFree (a, S)));
   295     val instT = rev (Term.add_tvars prop []) |> map (fn v as ((a, _), S) => (v, TFree (a, S)));
   285     val instT = map (fn (v, T) => (certT (TVar v), certT T)) instT0;
       
   286     val inst = rev (Term.add_vars prop []) |> map (fn ((a, i), T) =>
   296     val inst = rev (Term.add_vars prop []) |> map (fn ((a, i), T) =>
   287       let val T' = Term_Subst.instantiateT instT0 T
   297       let val T' = Term_Subst.instantiateT instT T
   288       in (cert (Var ((a, i), T')), cert (Free ((a, T')))) end);
   298       in (((a, i), T'), Free ((a, T'))) end);
   289   in Thm.instantiate (instT, inst) th end;
   299   in certify_instantiate (instT, inst) th end;
   290 
   300 
   291 
   301 
   292 (* close_derivation *)
   302 (* close_derivation *)
   293 
   303 
   294 fun close_derivation thm =
   304 fun close_derivation thm =