172 |
172 |
173 val cong_attrs = @{attributes [cong]}; |
173 val cong_attrs = @{attributes [cong]}; |
174 val dest_attrs = @{attributes [dest]}; |
174 val dest_attrs = @{attributes [dest]}; |
175 val safe_elim_attrs = @{attributes [elim!]}; |
175 val safe_elim_attrs = @{attributes [elim!]}; |
176 val iff_attrs = @{attributes [iff]}; |
176 val iff_attrs = @{attributes [iff]}; |
177 val induct_simp_attrs = @{attributes [induct_simp]}; |
177 val inductsimp_attrs = @{attributes [induct_simp]}; |
178 val nitpick_attrs = @{attributes [nitpick_simp]}; |
178 val nitpicksimp_attrs = @{attributes [nitpick_simp]}; |
179 val simp_attrs = @{attributes [simp]}; |
179 val simp_attrs = @{attributes [simp]}; |
180 val code_nitpick_simp_simp_attrs = Code.add_default_eqn_attrib :: nitpick_attrs @ simp_attrs; |
180 val code_nitpicksimp_simp_attrs = Code.add_default_eqn_attrib :: nitpicksimp_attrs @ simp_attrs; |
181 |
181 |
182 fun unflat_lookup eq xs ys = map (fn xs' => permute_like eq xs xs' ys); |
182 fun unflat_lookup eq xs ys = map (fn xs' => permute_like eq xs xs' ys); |
183 |
183 |
184 fun mk_half_pairss' _ ([], []) = [] |
184 fun mk_half_pairss' _ ([], []) = [] |
185 | mk_half_pairss' indent (x :: xs, _ :: ys) = |
185 | mk_half_pairss' indent (x :: xs, _ :: ys) = |
868 |
868 |
869 val exhaust_case_names_attr = Attrib.internal (K (Rule_Cases.case_names exhaust_cases)); |
869 val exhaust_case_names_attr = Attrib.internal (K (Rule_Cases.case_names exhaust_cases)); |
870 val cases_type_attr = Attrib.internal (K (Induct.cases_type fcT_name)); |
870 val cases_type_attr = Attrib.internal (K (Induct.cases_type fcT_name)); |
871 |
871 |
872 val notes = |
872 val notes = |
873 [(caseN, case_thms, code_nitpick_simp_simp_attrs), |
873 [(caseN, case_thms, code_nitpicksimp_simp_attrs), |
874 (case_congN, [case_cong_thm], []), |
874 (case_congN, [case_cong_thm], []), |
875 (case_conv_ifN, case_conv_if_thms, []), |
875 (case_conv_ifN, case_conv_if_thms, []), |
876 (collapseN, safe_collapse_thms, simp_attrs), |
876 (collapseN, safe_collapse_thms, simp_attrs), |
877 (discN, nontriv_disc_thms, simp_attrs), |
877 (discN, nontriv_disc_thms, simp_attrs), |
878 (discIN, nontriv_discI_thms, []), |
878 (discIN, nontriv_discI_thms, []), |
879 (disc_excludeN, disc_exclude_thms, dest_attrs), |
879 (disc_excludeN, disc_exclude_thms, dest_attrs), |
880 (disc_exhaustN, disc_exhaust_thms, [exhaust_case_names_attr]), |
880 (disc_exhaustN, disc_exhaust_thms, [exhaust_case_names_attr]), |
881 (distinctN, distinct_thms, simp_attrs @ induct_simp_attrs), |
881 (distinctN, distinct_thms, simp_attrs @ inductsimp_attrs), |
882 (exhaustN, [exhaust_thm], [exhaust_case_names_attr, cases_type_attr]), |
882 (exhaustN, [exhaust_thm], [exhaust_case_names_attr, cases_type_attr]), |
883 (expandN, expand_thms, []), |
883 (expandN, expand_thms, []), |
884 (injectN, inject_thms, iff_attrs @ induct_simp_attrs), |
884 (injectN, inject_thms, iff_attrs @ inductsimp_attrs), |
885 (nchotomyN, [nchotomy_thm], []), |
885 (nchotomyN, [nchotomy_thm], []), |
886 (selN, all_sel_thms, code_nitpick_simp_simp_attrs), |
886 (selN, all_sel_thms, code_nitpicksimp_simp_attrs), |
887 (sel_exhaustN, sel_exhaust_thms, [exhaust_case_names_attr]), |
887 (sel_exhaustN, sel_exhaust_thms, [exhaust_case_names_attr]), |
888 (sel_splitN, sel_split_thms, []), |
888 (sel_splitN, sel_split_thms, []), |
889 (sel_split_asmN, sel_split_asm_thms, []), |
889 (sel_split_asmN, sel_split_asm_thms, []), |
890 (splitN, [split_thm], []), |
890 (splitN, [split_thm], []), |
891 (split_asmN, [split_asm_thm], []), |
891 (split_asmN, [split_asm_thm], []), |
893 (weak_case_cong_thmsN, [weak_case_cong_thm], cong_attrs)] |
893 (weak_case_cong_thmsN, [weak_case_cong_thm], cong_attrs)] |
894 |> filter_out (null o #2) |
894 |> filter_out (null o #2) |
895 |> map (fn (thmN, thms, attrs) => |
895 |> map (fn (thmN, thms, attrs) => |
896 ((qualify true (Binding.name thmN), attrs), [(thms, [])])); |
896 ((qualify true (Binding.name thmN), attrs), [(thms, [])])); |
897 |
897 |
898 val notes' = |
898 val anonymous_notes = |
899 [(map (fn th => th RS notE) distinct_thms, safe_elim_attrs)] |
899 [(map (fn th => th RS notE) distinct_thms, safe_elim_attrs)] |
900 |> map (fn (thms, attrs) => ((Binding.empty, attrs), [(thms, [])])); |
900 |> map (fn (thms, attrs) => ((Binding.empty, attrs), [(thms, [])])); |
901 |
901 |
902 val ctr_sugar = |
902 val ctr_sugar = |
903 {ctrs = ctrs, casex = casex, discs = discs, selss = selss, exhaust = exhaust_thm, |
903 {ctrs = ctrs, casex = casex, discs = discs, selss = selss, exhaust = exhaust_thm, |