equal
deleted
inserted
replaced
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 |