src/HOL/Tools/BNF/bnf_fp_def_sugar.ML
changeset 63813 076129f60a31
parent 63803 761f81af2458
child 63814 f84d100e4c6d
equal deleted inserted replaced
63812:5f8643e8ced5 63813:076129f60a31
  2111       | extras => error ("Extra type variables on right-hand side: " ^
  2111       | extras => error ("Extra type variables on right-hand side: " ^
  2112           commas (map (qsoty o TFree) extras)));
  2112           commas (map (qsoty o TFree) extras)));
  2113 
  2113 
  2114     val fake_Ts = map (fn s => Type (s, As)) fake_T_names;
  2114     val fake_Ts = map (fn s => Type (s, As)) fake_T_names;
  2115 
  2115 
  2116     val ((((Bs0, Cs), Es), Xs), _) =
  2116     val ((((Bs0, Cs), Es), Xs), _) = no_defs_lthy
  2117       no_defs_lthy
       
  2118       |> fold (Variable.declare_typ o resort_tfree_or_tvar dummyS) unsorted_As
  2117       |> fold (Variable.declare_typ o resort_tfree_or_tvar dummyS) unsorted_As
  2119       |> mk_TFrees num_As
  2118       |> mk_TFrees num_As
  2120       ||>> mk_TFrees nn
  2119       ||>> mk_TFrees nn
  2121       ||>> mk_TFrees nn
  2120       ||>> mk_TFrees nn
  2122       ||>> variant_tfrees fp_b_names;
  2121       ||>> variant_tfrees fp_b_names;
  2168     val killed_As =
  2167     val killed_As =
  2169       map_filter (fn (A, set_bos) => if exists is_none set_bos then SOME A else NONE)
  2168       map_filter (fn (A, set_bos) => if exists is_none set_bos then SOME A else NONE)
  2170         (As ~~ transpose set_boss);
  2169         (As ~~ transpose set_boss);
  2171 
  2170 
  2172     val (((pre_bnfs, absT_infos), _), (fp_res as {bnfs = fp_bnfs as any_fp_bnf :: _, ctors = ctors0,
  2171     val (((pre_bnfs, absT_infos), _), (fp_res as {bnfs = fp_bnfs as any_fp_bnf :: _, ctors = ctors0,
  2173              dtors = dtors0, xtor_co_recs = xtor_co_recs0, xtor_co_induct, dtor_ctors,
  2172              dtors = dtors0, xtor_co_recs = xtor_co_recs0, xtor_co_induct, dtor_ctors, ctor_dtors,
  2174              ctor_dtors, ctor_injects, dtor_injects, xtor_maps, xtor_setss, xtor_rels,
  2173              ctor_injects, dtor_injects, xtor_maps, xtor_setss, xtor_rels, xtor_co_rec_thms,
  2175              xtor_co_rec_thms, xtor_rel_co_induct, dtor_set_inducts,
  2174              xtor_rel_co_induct, dtor_set_inducts, xtor_co_rec_transfers, xtor_co_rec_o_maps, ...},
  2176              xtor_co_rec_transfers, xtor_co_rec_o_maps, ...},
       
  2177            lthy)) =
  2175            lthy)) =
  2178       fixpoint_bnf false I (construct_fp mixfixes map_bs rel_bs pred_bs set_bss) fp_bs
  2176       fixpoint_bnf false I (construct_fp mixfixes map_bs rel_bs pred_bs set_bss) fp_bs
  2179         (map dest_TFree As) (map dest_TFree killed_As) (map dest_TFree Xs) ctrXs_repTs
  2177         (map dest_TFree As) (map dest_TFree killed_As) (map dest_TFree Xs) ctrXs_repTs
  2180         empty_comp_cache no_defs_lthy
  2178         empty_comp_cache no_defs_lthy
  2181       handle BAD_DEAD (X, X_backdrop) =>
  2179       handle BAD_DEAD (X, X_backdrop) =>