src/HOL/BNF/Tools/bnf_lfp_rec_sugar.ML
changeset 55005 38ea5ee18a06
parent 54979 d7593bfccf25
equal deleted inserted replaced
55004:96dfb73bb11a 55005:38ea5ee18a06
   131       | massage_call t = if t = y then y_of_y' () else ill_formed_rec_call ctxt t;
   131       | massage_call t = if t = y then y_of_y' () else ill_formed_rec_call ctxt t;
   132   in
   132   in
   133     massage_call
   133     massage_call
   134   end;
   134   end;
   135 
   135 
   136 fun rec_specs_of bs arg_Ts res_Ts get_indices callssss0 lthy =
   136 fun rec_specs_of bs arg_Ts res_Ts get_indices callssss0 lthy0 =
   137   let
   137   let
   138     val thy = Proof_Context.theory_of lthy;
   138     val thy = Proof_Context.theory_of lthy0;
   139 
   139 
   140     val ((missing_arg_Ts, perm0_kks,
   140     val ((missing_arg_Ts, perm0_kks,
   141           fp_sugars as {nested_bnfs, fp_res = {xtor_co_iterss = ctor_iters1 :: _, ...},
   141           fp_sugars as {nested_bnfs, fp_res = {xtor_co_iterss = ctor_iters1 :: _, ...},
   142             co_inducts = [induct_thm], ...} :: _, (lfp_sugar_thms, _)), lthy') =
   142             co_inducts = [induct_thm], ...} :: _, (lfp_sugar_thms, _)), lthy) =
   143       nested_to_mutual_fps Least_FP bs arg_Ts get_indices callssss0 lthy;
   143       nested_to_mutual_fps Least_FP bs arg_Ts get_indices callssss0 lthy0;
   144 
   144 
   145     val perm_fp_sugars = sort (int_ord o pairself #index) fp_sugars;
   145     val perm_fp_sugars = sort (int_ord o pairself #index) fp_sugars;
   146 
   146 
   147     val indices = map #index fp_sugars;
   147     val indices = map #index fp_sugars;
   148     val perm_indices = map #index perm_fp_sugars;
   148     val perm_indices = map #index perm_fp_sugars;
   212       {recx = mk_co_iter thy Least_FP (substAT T) perm_Cs' (co_rec_of (nth iterss index)),
   212       {recx = mk_co_iter thy Least_FP (substAT T) perm_Cs' (co_rec_of (nth iterss index)),
   213        nested_map_idents = map (unfold_thms lthy @{thms id_def} o map_id0_of_bnf) nested_bnfs,
   213        nested_map_idents = map (unfold_thms lthy @{thms id_def} o map_id0_of_bnf) nested_bnfs,
   214        nested_map_comps = map map_comp_of_bnf nested_bnfs,
   214        nested_map_comps = map map_comp_of_bnf nested_bnfs,
   215        ctr_specs = mk_ctr_specs index ctr_sugars iter_thmsss};
   215        ctr_specs = mk_ctr_specs index ctr_sugars iter_thmsss};
   216   in
   216   in
   217     ((is_some lfp_sugar_thms, map mk_spec fp_sugars, missing_arg_Ts, induct_thm, induct_thms),
   217     ((is_some lfp_sugar_thms, map mk_spec fp_sugars, missing_arg_Ts, induct_thm, induct_thms), lthy)
   218      lthy')
       
   219   end;
   218   end;
   220 
   219 
   221 val undef_const = Const (@{const_name undefined}, dummyT);
   220 val undef_const = Const (@{const_name undefined}, dummyT);
   222 
   221 
   223 fun permute_args n t =
   222 fun permute_args n t =