updated to infer_instantiate;
authorwenzelm
Sun, 26 Jul 2015 22:19:14 +0200
changeset 60792 722cb21ab680
parent 60791 e3f2262786ea
child 60793 bbcd4ab6d26e
updated to infer_instantiate;
src/HOL/Nominal/nominal_fresh_fun.ML
src/HOL/Nominal/nominal_primrec.ML
--- a/src/HOL/Nominal/nominal_fresh_fun.ML	Sun Jul 26 22:07:37 2015 +0200
+++ b/src/HOL/Nominal/nominal_fresh_fun.ML	Sun Jul 26 22:19:14 2015 +0200
@@ -22,8 +22,8 @@
       (head_of (Logic.incr_indexes ([], Ts, j) t),
        fold_rev Term.abs ps u)) tinst;
     val th' = instf
-      (map (apply2 (Thm.ctyp_of ctxt)) tyinst')
-      (map (apply2 (Thm.cterm_of ctxt)) tinst')
+      (map (apsnd (Thm.ctyp_of ctxt)) tyinst')
+      (map (apsnd (Thm.cterm_of ctxt)) tinst')
       (Thm.lift_rule cgoal th)
   in
     compose_tac ctxt (elim, th', Thm.nprems_of th) i st
@@ -33,11 +33,12 @@
 fun res_inst_tac_term ctxt =
   gen_res_inst_tac_term ctxt (fn instT => fn inst =>
     Thm.instantiate
-     (map (apfst (dest_TVar o Thm.typ_of)) instT,
-      map (apfst (dest_Var o Thm.term_of)) inst));
+     (map (apfst dest_TVar) instT,
+      map (apfst dest_Var) inst));
 
 fun res_inst_tac_term' ctxt =
-  gen_res_inst_tac_term ctxt (K Drule.cterm_instantiate) [];
+  gen_res_inst_tac_term ctxt
+    (fn _ => fn inst => infer_instantiate ctxt (map (apfst (#1 o dest_Var)) inst)) [];
 
 fun cut_inst_tac_term' ctxt tinst th =
   res_inst_tac_term' ctxt tinst false (Rule_Insts.make_elim_preserve ctxt th);
--- a/src/HOL/Nominal/nominal_primrec.ML	Sun Jul 26 22:07:37 2015 +0200
+++ b/src/HOL/Nominal/nominal_primrec.ML	Sun Jul 26 22:19:14 2015 +0200
@@ -281,7 +281,6 @@
     val qualify = Binding.qualify false
       (space_implode "_" (map (Long_Name.base_name o #1) defs));
     val names_atts' = map (apfst qualify) names_atts;
-    val cert = Thm.cterm_of lthy';
 
     fun mk_idx eq =
       let
@@ -305,16 +304,16 @@
         (fold_rev (Term.add_vars o Logic.strip_assums_concl)
            (Thm.prems_of (hd rec_rewrites)) []));
     val cfs = defs' |> hd |> snd |> strip_comb |> snd |>
-      curry (List.take o swap) (length fvars) |> map cert;
+      curry (List.take o swap) (length fvars) |> map (Thm.cterm_of lthy');
     val invs' = (case invs of
         NONE => map (fn (i, _) =>
           Abs ("x", fastype_of (snd (nth defs' i)), @{term True})) descr
       | SOME invs' => map (prep_term lthy') invs');
-    val inst = (map cert fvars ~~ cfs) @
-      (map (cert o Var) pvars ~~ map cert invs') @
+    val inst = (map (#1 o dest_Var) fvars ~~ cfs) @
+      (map #1 pvars ~~ map (Thm.cterm_of lthy') invs') @
       (case ctxtvars of
-         [ctxtvar] => [(cert (Var ctxtvar),
-           cert (the_default HOLogic.unit (Option.map (prep_term lthy') fctxt)))]
+         [ctxtvar] => [(#1 ctxtvar,
+           Thm.cterm_of lthy' (the_default HOLogic.unit (Option.map (prep_term lthy') fctxt)))]
        | _ => []);
     val rec_rewrites' = map (fn eq =>
       let
@@ -324,24 +323,24 @@
           HOLogic.dest_eq |> fst |> strip_comb |> snd |> List.last |>
           strip_comb |> snd
       in (cargs, Logic.strip_imp_prems eq,
-        Drule.cterm_instantiate (inst @
-          (map cert cargs' ~~ map (cert o Free) cargs)) th)
+        infer_instantiate lthy' (inst @
+          (map (#1 o dest_Var) cargs' ~~ map (Thm.cterm_of lthy' o Free) cargs)) th)
       end) eqns';
 
     val prems = foldr1 (common_prefix op aconv) (map (Thm.prems_of o #3) rec_rewrites');
-    val cprems = map cert prems;
+    val cprems = map (Thm.cterm_of lthy') prems;
     val asms = map Thm.assume cprems;
     val premss = map (fn (cargs, eprems, eqn) =>
       map (fn t => fold_rev (Logic.all o Free) cargs (Logic.list_implies (eprems, t)))
         (List.drop (Thm.prems_of eqn, length prems))) rec_rewrites';
-    val cpremss = map (map cert) premss;
+    val cpremss = map (map (Thm.cterm_of lthy')) premss;
     val asmss = map (map Thm.assume) cpremss;
 
     fun mk_eqn ((cargs, eprems, eqn), asms') =
       let
-        val ceprems = map cert eprems;
+        val ceprems = map (Thm.cterm_of lthy') eprems;
         val asms'' = map Thm.assume ceprems;
-        val ccargs = map (cert o Free) cargs;
+        val ccargs = map (Thm.cterm_of lthy' o Free) cargs;
         val asms''' = map (fn th => implies_elim_list
           (forall_elim_list ccargs th) asms'') asms'
       in
@@ -410,4 +409,3 @@
         primrec_cmd invs fctxt fixes params specs));
 
 end;
-