src/HOL/Tools/inductive_realizer.ML
changeset 58963 26bf09b95dda
parent 58372 bfd497f2f4c2
child 59058 a78612c67ec0
equal deleted inserted replaced
58960:4bee6d8c1500 58963:26bf09b95dda
   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'