src/HOL/BNF/Tools/bnf_fp_sugar.ML
changeset 49592 b859a02c1150
parent 49591 91b228e26348
child 49593 c958f282b382
equal deleted inserted replaced
49591:91b228e26348 49592:b859a02c1150
   530                  (unfold_thms lthy (pre_rel_def :: (if lfp then [] else [dtor_ctor]) @
   530                  (unfold_thms lthy (pre_rel_def :: (if lfp then [] else [dtor_ctor]) @
   531                       sum_prod_thms_rel)
   531                       sum_prod_thms_rel)
   532                     (cterm_instantiate_pos (nones @ [SOME cxIn, SOME cyIn]) fp_rel_thm))
   532                     (cterm_instantiate_pos (nones @ [SOME cxIn, SOME cyIn]) fp_rel_thm))
   533               |> postproc |> thaw (xs @ ys);
   533               |> postproc |> thaw (xs @ ys);
   534 
   534 
   535             fun mk_pos_rel_thm (((ctr_def', xs), cxIn), ((_, ys), cyIn)) =
   535             fun mk_rel_inject_thm (((ctr_def', xs), cxIn), ((_, ys), cyIn)) =
   536               mk_rel_thm (unfold_thms lthy @{thms eq_sym_Unity_conv}) [ctr_def'] xs cxIn ys cyIn;
   536               mk_rel_thm (unfold_thms lthy @{thms eq_sym_Unity_conv}) [ctr_def'] xs cxIn ys cyIn;
   537 
   537 
   538             val pos_rel_thms = map mk_pos_rel_thm (op ~~ rel_infos);
   538             val rel_inject_thms = map mk_rel_inject_thm (op ~~ rel_infos);
   539 
   539 
   540             fun mk_half_neg_rel_thm (((xctr_def', xs), cxIn), ((yctr_def', ys), cyIn)) =
   540             fun mk_half_rel_distinct_thm (((xctr_def', xs), cxIn), ((yctr_def', ys), cyIn)) =
   541               mk_rel_thm (fn thm => thm RS @{thm eq_False[THEN iffD1]}) [xctr_def', yctr_def']
   541               mk_rel_thm (fn thm => thm RS @{thm eq_False[THEN iffD1]}) [xctr_def', yctr_def']
   542                 xs cxIn ys cyIn;
   542                 xs cxIn ys cyIn;
   543 
   543 
   544             fun mk_other_half_neg_rel_thm thm =
   544             fun mk_other_half_rel_distinct_thm thm =
   545               flip_rels lthy live thm RS (rel_flip RS sym RS @{thm arg_cong[of _ _ Not]} RS iffD2);
   545               flip_rels lthy live thm RS (rel_flip RS sym RS @{thm arg_cong[of _ _ Not]} RS iffD2);
   546 
   546 
   547             val half_neg_rel_thmss = map (map mk_half_neg_rel_thm) (mk_half_pairss rel_infos);
   547             val half_rel_distinct_thmss =
   548             val other_half_neg_rel_thmss = map (map mk_other_half_neg_rel_thm) half_neg_rel_thmss;
   548               map (map mk_half_rel_distinct_thm) (mk_half_pairss rel_infos);
   549             val (neg_rel_thms, _) = join_halves n half_neg_rel_thmss other_half_neg_rel_thmss;
   549             val other_half_rel_distinct_thmss =
   550 
   550               map (map mk_other_half_rel_distinct_thm) half_rel_distinct_thmss;
   551             val rel_thms = pos_rel_thms @ neg_rel_thms;
   551             val (rel_distinct_thms, _) =
       
   552               join_halves n half_rel_distinct_thmss other_half_rel_distinct_thmss;
   552 
   553 
   553             val notes =
   554             val notes =
   554               [(mapsN, map_thms, code_simp_attrs),
   555               [(mapsN, map_thms, code_simp_attrs),
   555                (relsN, rel_thms, code_simp_attrs),
   556                (rel_distinctN, rel_distinct_thms, code_simp_attrs),
       
   557                (rel_injectN, rel_inject_thms, code_simp_attrs),
   556                (setsN, flat set_thmss, code_simp_attrs)]
   558                (setsN, flat set_thmss, code_simp_attrs)]
   557               |> filter_out (null o #2)
   559               |> filter_out (null o #2)
   558               |> map (fn (thmN, thms, attrs) =>
   560               |> map (fn (thmN, thms, attrs) =>
   559                 ((Binding.qualify true fp_b_name (Binding.name thmN), attrs), [(thms, [])]));
   561                 ((Binding.qualify true fp_b_name (Binding.name thmN), attrs), [(thms, [])]));
   560           in
   562           in