1600 in Logic.mk_equals (Logic.all s (P $ s), fold_rev Logic.all vars_more (P $ ext)) end; |
1600 in Logic.mk_equals (Logic.all s (P $ s), fold_rev Logic.all vars_more (P $ ext)) end; |
1601 |
1601 |
1602 val inject = timeit_msg ctxt "record extension inject proof:" (fn () => |
1602 val inject = timeit_msg ctxt "record extension inject proof:" (fn () => |
1603 simplify (put_simpset HOL_ss defs_ctxt) |
1603 simplify (put_simpset HOL_ss defs_ctxt) |
1604 (Goal.prove_sorry_global defs_thy [] [] inject_prop |
1604 (Goal.prove_sorry_global defs_thy [] [] inject_prop |
1605 (fn {context = ctxt, ...} => |
1605 (fn {context = ctxt', ...} => |
1606 simp_tac (put_simpset HOL_basic_ss ctxt addsimps [ext_def]) 1 THEN |
1606 simp_tac (put_simpset HOL_basic_ss ctxt' addsimps [ext_def]) 1 THEN |
1607 REPEAT_DETERM |
1607 REPEAT_DETERM |
1608 (resolve_tac ctxt @{thms refl_conj_eq} 1 ORELSE |
1608 (resolve_tac ctxt' @{thms refl_conj_eq} 1 ORELSE |
1609 Iso_Tuple_Support.iso_tuple_intros_tac ctxt 1 ORELSE |
1609 Iso_Tuple_Support.iso_tuple_intros_tac ctxt' 1 ORELSE |
1610 resolve_tac ctxt [refl] 1)))); |
1610 resolve_tac ctxt' [refl] 1)))); |
1611 |
1611 |
1612 |
1612 |
1613 (*We need a surjection property r = (| f = f r, g = g r ... |) |
1613 (*We need a surjection property r = (| f = f r, g = g r ... |) |
1614 to prove other theorems. We haven't given names to the accessors |
1614 to prove other theorems. We haven't given names to the accessors |
1615 f, g etc yet however, so we generate an ext structure with |
1615 f, g etc yet however, so we generate an ext structure with |
1632 surject |
1632 surject |
1633 end); |
1633 end); |
1634 |
1634 |
1635 val split_meta = timeit_msg ctxt "record extension split_meta proof:" (fn () => |
1635 val split_meta = timeit_msg ctxt "record extension split_meta proof:" (fn () => |
1636 Goal.prove_sorry_global defs_thy [] [] split_meta_prop |
1636 Goal.prove_sorry_global defs_thy [] [] split_meta_prop |
1637 (fn {context = ctxt, ...} => |
1637 (fn {context = ctxt', ...} => |
1638 EVERY1 |
1638 EVERY1 |
1639 [resolve_tac ctxt @{thms equal_intr_rule}, |
1639 [resolve_tac ctxt' @{thms equal_intr_rule}, |
1640 Goal.norm_hhf_tac ctxt, |
1640 Goal.norm_hhf_tac ctxt', |
1641 eresolve_tac ctxt @{thms meta_allE}, assume_tac ctxt, |
1641 eresolve_tac ctxt' @{thms meta_allE}, assume_tac ctxt', |
1642 resolve_tac ctxt [@{thm prop_subst} OF [surject]], |
1642 resolve_tac ctxt' [@{thm prop_subst} OF [surject]], |
1643 REPEAT o eresolve_tac ctxt @{thms meta_allE}, assume_tac ctxt])); |
1643 REPEAT o eresolve_tac ctxt' @{thms meta_allE}, assume_tac ctxt'])); |
1644 |
1644 |
1645 val induct = timeit_msg ctxt "record extension induct proof:" (fn () => |
1645 val induct = timeit_msg ctxt "record extension induct proof:" (fn () => |
1646 let val (assm, concl) = induct_prop in |
1646 let val (assm, concl) = induct_prop in |
1647 Goal.prove_sorry_global defs_thy [] [assm] concl |
1647 Goal.prove_sorry_global defs_thy [] [assm] concl |
1648 (fn {context = ctxt, prems, ...} => |
1648 (fn {context = ctxt', prems, ...} => |
1649 cut_tac (split_meta RS Drule.equal_elim_rule2) 1 THEN |
1649 cut_tac (split_meta RS Drule.equal_elim_rule2) 1 THEN |
1650 resolve_tac ctxt prems 2 THEN |
1650 resolve_tac ctxt' prems 2 THEN |
1651 asm_simp_tac (put_simpset HOL_ss ctxt) 1) |
1651 asm_simp_tac (put_simpset HOL_ss ctxt') 1) |
1652 end); |
1652 end); |
1653 |
1653 |
1654 val ([(_, [induct']), (_, [inject']), (_, [surjective']), (_, [split_meta'])], thm_thy) = |
1654 val ([(_, [induct']), (_, [inject']), (_, [surjective']), (_, [split_meta'])], thm_thy) = |
1655 defs_thy |
1655 defs_thy |
1656 |> Global_Theory.note_thmss "" |
1656 |> Global_Theory.note_thmss "" |
2139 |
2139 |
2140 val parent_induct = Option.map #induct_scheme (try List.last parents); |
2140 val parent_induct = Option.map #induct_scheme (try List.last parents); |
2141 |
2141 |
2142 val induct_scheme = timeit_msg defs_ctxt "record induct_scheme proof:" (fn () => |
2142 val induct_scheme = timeit_msg defs_ctxt "record induct_scheme proof:" (fn () => |
2143 Goal.prove_sorry_global defs_thy [] [] induct_scheme_prop |
2143 Goal.prove_sorry_global defs_thy [] [] induct_scheme_prop |
2144 (fn {context = ctxt, ...} => |
2144 (fn {context = ctxt', ...} => |
2145 EVERY |
2145 EVERY |
2146 [case parent_induct of NONE => all_tac | SOME ind => try_param_tac ctxt rN ind 1, |
2146 [case parent_induct of NONE => all_tac | SOME ind => try_param_tac ctxt' rN ind 1, |
2147 try_param_tac ctxt rN ext_induct 1, |
2147 try_param_tac ctxt' rN ext_induct 1, |
2148 asm_simp_tac (put_simpset HOL_basic_ss ctxt) 1])); |
2148 asm_simp_tac (put_simpset HOL_basic_ss ctxt') 1])); |
2149 |
2149 |
2150 val induct = timeit_msg defs_ctxt "record induct proof:" (fn () => |
2150 val induct = timeit_msg defs_ctxt "record induct proof:" (fn () => |
2151 Goal.prove_sorry_global defs_thy [] [#1 induct_prop] (#2 induct_prop) |
2151 Goal.prove_sorry_global defs_thy [] [#1 induct_prop] (#2 induct_prop) |
2152 (fn {context = ctxt, prems, ...} => |
2152 (fn {context = ctxt', prems, ...} => |
2153 try_param_tac ctxt rN induct_scheme 1 |
2153 try_param_tac ctxt' rN induct_scheme 1 |
2154 THEN try_param_tac ctxt "more" @{thm unit.induct} 1 |
2154 THEN try_param_tac ctxt' "more" @{thm unit.induct} 1 |
2155 THEN resolve_tac ctxt prems 1)); |
2155 THEN resolve_tac ctxt' prems 1)); |
2156 |
2156 |
2157 val surjective = timeit_msg defs_ctxt "record surjective proof:" (fn () => |
2157 val surjective = timeit_msg defs_ctxt "record surjective proof:" (fn () => |
2158 Goal.prove_sorry_global defs_thy [] [] surjective_prop |
2158 Goal.prove_sorry_global defs_thy [] [] surjective_prop |
2159 (fn {context = ctxt, ...} => |
2159 (fn {context = ctxt', ...} => |
2160 EVERY |
2160 EVERY |
2161 [resolve_tac ctxt [surject_assist_idE] 1, |
2161 [resolve_tac ctxt' [surject_assist_idE] 1, |
2162 simp_tac (put_simpset HOL_basic_ss ctxt addsimps ext_defs) 1, |
2162 simp_tac (put_simpset HOL_basic_ss ctxt' addsimps ext_defs) 1, |
2163 REPEAT |
2163 REPEAT |
2164 (Iso_Tuple_Support.iso_tuple_intros_tac ctxt 1 ORELSE |
2164 (Iso_Tuple_Support.iso_tuple_intros_tac ctxt' 1 ORELSE |
2165 (resolve_tac ctxt [surject_assistI] 1 THEN |
2165 (resolve_tac ctxt' [surject_assistI] 1 THEN |
2166 simp_tac (put_simpset (get_sel_upd_defs defs_thy) ctxt |
2166 simp_tac (put_simpset (get_sel_upd_defs defs_thy) ctxt' |
2167 addsimps (sel_defs @ @{thms o_assoc id_apply id_o o_id})) 1))])); |
2167 addsimps (sel_defs @ @{thms o_assoc id_apply id_o o_id})) 1))])); |
2168 |
2168 |
2169 val cases_scheme = timeit_msg defs_ctxt "record cases_scheme proof:" (fn () => |
2169 val cases_scheme = timeit_msg defs_ctxt "record cases_scheme proof:" (fn () => |
2170 Goal.prove_sorry_global defs_thy [] [#1 cases_scheme_prop] (#2 cases_scheme_prop) |
2170 Goal.prove_sorry_global defs_thy [] [#1 cases_scheme_prop] (#2 cases_scheme_prop) |
2171 (fn {context = ctxt, prems, ...} => |
2171 (fn {context = ctxt', prems, ...} => |
2172 resolve_tac ctxt prems 1 THEN |
2172 resolve_tac ctxt' prems 1 THEN |
2173 resolve_tac ctxt [surjective] 1)); |
2173 resolve_tac ctxt' [surjective] 1)); |
2174 |
2174 |
2175 val cases = timeit_msg defs_ctxt "record cases proof:" (fn () => |
2175 val cases = timeit_msg defs_ctxt "record cases proof:" (fn () => |
2176 Goal.prove_sorry_global defs_thy [] [] cases_prop |
2176 Goal.prove_sorry_global defs_thy [] [] cases_prop |
2177 (fn {context = ctxt, ...} => |
2177 (fn {context = ctxt', ...} => |
2178 try_param_tac ctxt rN cases_scheme 1 THEN |
2178 try_param_tac ctxt' rN cases_scheme 1 THEN |
2179 ALLGOALS (asm_full_simp_tac |
2179 ALLGOALS (asm_full_simp_tac |
2180 (put_simpset HOL_basic_ss ctxt addsimps @{thms unit_all_eq1})))); |
2180 (put_simpset HOL_basic_ss ctxt' addsimps @{thms unit_all_eq1})))); |
2181 |
2181 |
2182 val split_meta = timeit_msg defs_ctxt "record split_meta proof:" (fn () => |
2182 val split_meta = timeit_msg defs_ctxt "record split_meta proof:" (fn () => |
2183 Goal.prove_sorry_global defs_thy [] [] split_meta_prop |
2183 Goal.prove_sorry_global defs_thy [] [] split_meta_prop |
2184 (fn {context = ctxt', ...} => |
2184 (fn {context = ctxt', ...} => |
2185 EVERY1 |
2185 EVERY1 |
2188 resolve_tac ctxt' [@{thm prop_subst} OF [surjective]], |
2188 resolve_tac ctxt' [@{thm prop_subst} OF [surjective]], |
2189 REPEAT o eresolve_tac ctxt' @{thms meta_allE}, assume_tac ctxt'])); |
2189 REPEAT o eresolve_tac ctxt' @{thms meta_allE}, assume_tac ctxt'])); |
2190 |
2190 |
2191 val split_object = timeit_msg defs_ctxt "record split_object proof:" (fn () => |
2191 val split_object = timeit_msg defs_ctxt "record split_object proof:" (fn () => |
2192 Goal.prove_sorry_global defs_thy [] [] split_object_prop |
2192 Goal.prove_sorry_global defs_thy [] [] split_object_prop |
2193 (fn {context = ctxt, ...} => |
2193 (fn {context = ctxt', ...} => |
2194 resolve_tac ctxt [@{lemma "Trueprop A \<equiv> Trueprop B \<Longrightarrow> A = B" by (rule iffI) unfold}] 1 THEN |
2194 resolve_tac ctxt' [@{lemma "Trueprop A \<equiv> Trueprop B \<Longrightarrow> A = B" by (rule iffI) unfold}] 1 THEN |
2195 rewrite_goals_tac ctxt @{thms atomize_all [symmetric]} THEN |
2195 rewrite_goals_tac ctxt' @{thms atomize_all [symmetric]} THEN |
2196 resolve_tac ctxt [split_meta] 1)); |
2196 resolve_tac ctxt' [split_meta] 1)); |
2197 |
2197 |
2198 val split_ex = timeit_msg defs_ctxt "record split_ex proof:" (fn () => |
2198 val split_ex = timeit_msg defs_ctxt "record split_ex proof:" (fn () => |
2199 Goal.prove_sorry_global defs_thy [] [] split_ex_prop |
2199 Goal.prove_sorry_global defs_thy [] [] split_ex_prop |
2200 (fn {context = ctxt, ...} => |
2200 (fn {context = ctxt', ...} => |
2201 simp_tac |
2201 simp_tac |
2202 (put_simpset HOL_basic_ss ctxt addsimps |
2202 (put_simpset HOL_basic_ss ctxt' addsimps |
2203 (@{lemma "\<exists>x. P x \<equiv> \<not> (\<forall>x. \<not> P x)" by simp} :: |
2203 (@{lemma "\<exists>x. P x \<equiv> \<not> (\<forall>x. \<not> P x)" by simp} :: |
2204 @{thms not_not Not_eq_iff})) 1 THEN |
2204 @{thms not_not Not_eq_iff})) 1 THEN |
2205 resolve_tac ctxt [split_object] 1)); |
2205 resolve_tac ctxt' [split_object] 1)); |
2206 |
2206 |
2207 val equality = timeit_msg defs_ctxt "record equality proof:" (fn () => |
2207 val equality = timeit_msg defs_ctxt "record equality proof:" (fn () => |
2208 Goal.prove_sorry_global defs_thy [] [] equality_prop |
2208 Goal.prove_sorry_global defs_thy [] [] equality_prop |
2209 (fn {context = ctxt, ...} => |
2209 (fn {context = ctxt', ...} => |
2210 asm_full_simp_tac (put_simpset record_ss ctxt addsimps (split_meta :: sel_convs)) 1)); |
2210 asm_full_simp_tac (put_simpset record_ss ctxt' addsimps (split_meta :: sel_convs)) 1)); |
2211 |
2211 |
2212 val ([(_, sel_convs'), (_, upd_convs'), (_, sel_defs'), (_, upd_defs'), |
2212 val ([(_, sel_convs'), (_, upd_convs'), (_, sel_defs'), (_, upd_defs'), |
2213 (_, fold_congs'), (_, unfold_congs'), |
2213 (_, fold_congs'), (_, unfold_congs'), |
2214 (_, splits' as [split_meta', split_object', split_ex']), (_, derived_defs'), |
2214 (_, splits' as [split_meta', split_object', split_ex']), (_, derived_defs'), |
2215 (_, [surjective']), (_, [equality']), (_, [induct_scheme']), (_, [induct']), |
2215 (_, [surjective']), (_, [equality']), (_, [induct_scheme']), (_, [induct']), |