src/HOL/Tools/BNF/bnf_lfp_basic_sugar.ML
changeset 63045 c50c764aab10
parent 62907 9ad0bac25a84
child 63170 eae6549dbea2
--- a/src/HOL/Tools/BNF/bnf_lfp_basic_sugar.ML	Fri Apr 22 15:34:37 2016 +0200
+++ b/src/HOL/Tools/BNF/bnf_lfp_basic_sugar.ML	Thu Apr 14 20:29:42 2016 +0200
@@ -28,7 +28,8 @@
   |> morph_ctr_sugar (Morphism.typ_morphism "BNF" Logic.unvarifyT_global
     $> Morphism.term_morphism "BNF" (Term.map_types Logic.unvarifyT_global));
 
-fun trivial_fp_result_of fp_bnf fpT C xtor_map xtor_sets xtor_rel ctor_rec_o_map xtor_rel_induct =
+fun trivial_fp_result_of fp_bnf fpT C xtor_map xtor_sets xtor_rel ctor_rec_o_map
+    xtor_rel_induct ctor_rec_transfer =
   let
     val xtors = [Const (@{const_name xtor}, fpT --> fpT)];
     val co_recs = [Const (@{const_name ctor_rec}, (fpT --> C) --> (fpT --> C))];
@@ -44,7 +45,8 @@
      xtor_un_fold_thms = co_rec_thms, xtor_co_rec_thms = co_rec_thms,
      xtor_un_fold_unique = co_rec_unique_thm, xtor_co_rec_unique = co_rec_unique_thm,
      xtor_un_fold_o_maps = [ctor_rec_o_map], xtor_co_rec_o_maps = [ctor_rec_o_map],
-     xtor_un_fold_transfers = [], xtor_co_rec_transfers = [],
+     xtor_un_fold_transfers = [ctor_rec_transfer],
+     xtor_co_rec_transfers = [ctor_rec_transfer],
      xtor_rel_co_induct = xtor_rel_induct, dtor_set_inducts = []}
   end;
 
@@ -62,6 +64,7 @@
     val xtor_rel = @{thm xtor_rel[of "rel_sum R1 R2" for R1 R2]};
     val ctor_rec_o_map = @{thm ctor_rec_o_map[of _ "map_sum g1 g2" for g1 g2]};
     val xtor_rel_induct = @{thm xtor_rel_induct[of "rel_sum R1 R2" for R1 R2]};
+    val ctor_rec_transfer = @{thm ctor_rec_transfer[of "rel_sum R1 R2" for R1 R2]};
   in
     {T = fpT,
      BT = fpBT,
@@ -69,7 +72,8 @@
      fp = Least_FP,
      fp_res_index = 0,
      fp_res =
-       trivial_fp_result_of fp_bnf fpT C xtor_map xtor_sets xtor_rel ctor_rec_o_map xtor_rel_induct,
+       trivial_fp_result_of fp_bnf fpT C xtor_map xtor_sets xtor_rel ctor_rec_o_map xtor_rel_induct
+         ctor_rec_transfer,
      pre_bnf = ID_bnf (*wrong*),
      fp_bnf = fp_bnf,
      absT_info = trivial_absT_info_of fpT,
@@ -132,6 +136,7 @@
     val xtor_rel = @{thm xtor_rel[of "rel_prod R1 R2" for R1 R2]};
     val ctor_rec_o_map = @{thm ctor_rec_o_map[of _ "map_prod g1 g2" for g1 g2]};
     val xtor_rel_induct = @{thm xtor_rel_induct[of "rel_prod R1 R2" for R1 R2]};
+    val ctor_rec_transfer = @{thm ctor_rec_transfer[of "rel_prod R1 R2" for R1 R2]};
   in
     {T = fpT,
      BT = fpBT,
@@ -139,7 +144,8 @@
      fp = Least_FP,
      fp_res_index = 0,
      fp_res =
-       trivial_fp_result_of fp_bnf fpT C xtor_map xtor_sets xtor_rel ctor_rec_o_map xtor_rel_induct,
+       trivial_fp_result_of fp_bnf fpT C xtor_map xtor_sets xtor_rel ctor_rec_o_map xtor_rel_induct
+         ctor_rec_transfer,
      pre_bnf = ID_bnf (*wrong*),
      fp_bnf = fp_bnf,
      absT_info = trivial_absT_info_of fpT,