395 (fn {context = ctxt, prems} => EVERY |
395 (fn {context = ctxt, prems} => EVERY |
396 [rtac (#raw_induct ind_info) 1, |
396 [rtac (#raw_induct ind_info) 1, |
397 rewrite_goals_tac ctxt rews, |
397 rewrite_goals_tac ctxt rews, |
398 REPEAT ((resolve_tac prems THEN_ALL_NEW EVERY' |
398 REPEAT ((resolve_tac prems THEN_ALL_NEW EVERY' |
399 [K (rewrite_goals_tac ctxt rews), Object_Logic.atomize_prems_tac ctxt, |
399 [K (rewrite_goals_tac ctxt rews), Object_Logic.atomize_prems_tac ctxt, |
400 DEPTH_SOLVE_1 o FIRST' [atac, etac allE, etac impE]]) 1)]); |
400 DEPTH_SOLVE_1 o FIRST' [assume_tac ctxt, etac allE, etac impE]]) 1)]); |
401 val (thm', thy') = Global_Theory.store_thm (Binding.qualified_name (space_implode "_" |
401 val (thm', thy') = Global_Theory.store_thm (Binding.qualified_name (space_implode "_" |
402 (Long_Name.qualify qualifier "induct" :: vs' @ Ps @ ["correctness"])), thm) thy; |
402 (Long_Name.qualify qualifier "induct" :: vs' @ Ps @ ["correctness"])), thm) thy; |
403 val thms = map (fn th => zero_var_indexes (rotate_prems ~1 (th RS mp))) |
403 val thms = map (fn th => zero_var_indexes (rotate_prems ~1 (th RS mp))) |
404 (Old_Datatype_Aux.split_conj_thm thm'); |
404 (Old_Datatype_Aux.split_conj_thm thm'); |
405 val ([thms'], thy'') = Global_Theory.add_thmss |
405 val ([thms'], thy'') = Global_Theory.add_thmss |
458 [cut_tac (hd prems) 1, |
458 [cut_tac (hd prems) 1, |
459 etac elimR 1, |
459 etac elimR 1, |
460 ALLGOALS (asm_simp_tac (put_simpset HOL_basic_ss ctxt)), |
460 ALLGOALS (asm_simp_tac (put_simpset HOL_basic_ss ctxt)), |
461 rewrite_goals_tac ctxt rews, |
461 rewrite_goals_tac ctxt rews, |
462 REPEAT ((resolve_tac prems THEN_ALL_NEW (Object_Logic.atomize_prems_tac ctxt THEN' |
462 REPEAT ((resolve_tac prems THEN_ALL_NEW (Object_Logic.atomize_prems_tac ctxt THEN' |
463 DEPTH_SOLVE_1 o FIRST' [atac, etac allE, etac impE])) 1)]); |
463 DEPTH_SOLVE_1 o FIRST' [assume_tac ctxt, etac allE, etac impE])) 1)]); |
464 val (thm', thy') = Global_Theory.store_thm (Binding.qualified_name (space_implode "_" |
464 val (thm', thy') = Global_Theory.store_thm (Binding.qualified_name (space_implode "_" |
465 (name_of_thm elim :: vs @ Ps @ ["correctness"])), thm) thy |
465 (name_of_thm elim :: vs @ Ps @ ["correctness"])), thm) thy |
466 in |
466 in |
467 Extraction.add_realizers_i |
467 Extraction.add_realizers_i |
468 [mk_realizer thy' (vs @ Ps) (name_of_thm elim, elim, thm', rlz, r)] thy' |
468 [mk_realizer thy' (vs @ Ps) (name_of_thm elim, elim, thm', rlz, r)] thy' |