src/HOL/Tools/BNF/bnf_lfp.ML
changeset 56114 bc7335979247
parent 56016 8875cdcfc85b
child 56192 d666cb0e4cf9
equal deleted inserted replaced
56113:e3b8f8319d73 56114:bc7335979247
   294       let
   294       let
   295         val goal = fold_rev Logic.all ss
   295         val goal = fold_rev Logic.all ss
   296           (HOLogic.mk_Trueprop (mk_talg activeAs ss))
   296           (HOLogic.mk_Trueprop (mk_talg activeAs ss))
   297       in
   297       in
   298         Goal.prove_sorry lthy [] [] goal
   298         Goal.prove_sorry lthy [] [] goal
   299           (K (stac alg_def 1 THEN CONJ_WRAP (K (EVERY' [rtac ballI, rtac UNIV_I] 1)) ss))
   299           (K (rtac (alg_def RS iffD2) 1 THEN CONJ_WRAP (K (EVERY' [rtac ballI, rtac UNIV_I] 1)) ss))
   300         |> Thm.close_derivation
   300         |> Thm.close_derivation
   301       end;
   301       end;
   302 
   302 
   303     val timer = time (timer "Algebra definition & thms");
   303     val timer = time (timer "Algebra definition & thms");
   304 
   304 
   983 
   983 
   984     val ((T_names, (T_glob_infos, T_loc_infos)), lthy) =
   984     val ((T_names, (T_glob_infos, T_loc_infos)), lthy) =
   985       lthy
   985       lthy
   986       |> fold_map3 (fn b => fn mx => fn car_init =>
   986       |> fold_map3 (fn b => fn mx => fn car_init =>
   987         typedef (Binding.conceal b, params, mx) car_init NONE
   987         typedef (Binding.conceal b, params, mx) car_init NONE
   988           (EVERY' [rtac ssubst, rtac @{thm ex_in_conv}, resolve_tac alg_not_empty_thms,
   988           (EVERY' [rtac iffD2, rtac @{thm ex_in_conv}, resolve_tac alg_not_empty_thms,
   989             rtac alg_init_thm] 1)) bs mixfixes car_inits
   989             rtac alg_init_thm] 1)) bs mixfixes car_inits
   990       |>> apsnd split_list o split_list;
   990       |>> apsnd split_list o split_list;
   991 
   991 
   992     val Ts = map (fn name => Type (name, params')) T_names;
   992     val Ts = map (fn name => Type (name, params')) T_names;
   993     fun mk_Ts passive = map (Term.typ_subst_atomic (passiveAs ~~ passive)) Ts;
   993     fun mk_Ts passive = map (Term.typ_subst_atomic (passiveAs ~~ passive)) Ts;
  1003     val Abs_inverses = map #Abs_inverse T_loc_infos;
  1003     val Abs_inverses = map #Abs_inverse T_loc_infos;
  1004 
  1004 
  1005     fun mk_inver_thm mk_tac rep abs X thm =
  1005     fun mk_inver_thm mk_tac rep abs X thm =
  1006       Goal.prove_sorry lthy [] []
  1006       Goal.prove_sorry lthy [] []
  1007         (HOLogic.mk_Trueprop (mk_inver rep abs X))
  1007         (HOLogic.mk_Trueprop (mk_inver rep abs X))
  1008         (K (EVERY' [rtac ssubst, rtac @{thm inver_def}, rtac ballI, mk_tac thm] 1))
  1008         (K (EVERY' [rtac iffD2, rtac @{thm inver_def}, rtac ballI, mk_tac thm] 1))
  1009       |> Thm.close_derivation;
  1009       |> Thm.close_derivation;
  1010 
  1010 
  1011     val inver_Reps = map4 (mk_inver_thm rtac) Abs_Ts Rep_Ts (map HOLogic.mk_UNIV Ts) Rep_inverses;
  1011     val inver_Reps = map4 (mk_inver_thm rtac) Abs_Ts Rep_Ts (map HOLogic.mk_UNIV Ts) Rep_inverses;
  1012     val inver_Abss = map4 (mk_inver_thm etac) Rep_Ts Abs_Ts car_inits Abs_inverses;
  1012     val inver_Abss = map4 (mk_inver_thm etac) Rep_Ts Abs_Ts car_inits Abs_inverses;
  1013 
  1013