made generation of transfer goals more robust w.r.t. dead variables
authortraytel
Fri, 29 Jul 2016 10:03:22 +0200
changeset 63565 91f03f3b6470
parent 63564 eca71be9c948
child 63567 41037360dcb7
made generation of transfer goals more robust w.r.t. dead variables
src/HOL/Tools/BNF/bnf_fp_rec_sugar_transfer.ML
--- a/src/HOL/Tools/BNF/bnf_fp_rec_sugar_transfer.ML	Fri Jul 29 15:00:51 2016 +0200
+++ b/src/HOL/Tools/BNF/bnf_fp_rec_sugar_transfer.ML	Fri Jul 29 10:03:22 2016 +0200
@@ -87,12 +87,16 @@
       |> mk_TFrees' (map snd skematic_Ts)
       ||>> mk_TFrees' (map snd skematic_Ts);
 
-    val (Rs, names_lthy) = mk_Frees "R" (map2 mk_pred2T As Bs) names_lthy;
+    val ((Rs, Rs'), names_lthy) = mk_Frees' "R" (map2 mk_pred2T As Bs) names_lthy;
 
     val fA = Term.subst_TVars (map fst skematic_Ts ~~ As) f;
     val fB = Term.subst_TVars (map fst skematic_Ts ~~ Bs) f;
+
+    val goal = mk_parametricity_goal lthy Rs fA fB;
+    val used_Rs = Term.add_frees goal [];
+    val subst = map (dest_pred2T o snd) (filter_out (member (op =) used_Rs) Rs');
   in
-    (mk_parametricity_goal lthy Rs fA fB, names_lthy)
+    (goal |> Term.subst_atomic_types subst, names_lthy)
   end;
 
 fun fp_rec_sugar_transfer_interpretation prove {transfers, fun_names, funs, fun_defs, fpTs} =