src/HOL/Tools/inductive.ML
changeset 35092 cfe605c54e50
parent 34991 1adaefa63c5a
child 35364 b8c62d60195c
equal deleted inserted replaced
35091:59b41ba431b5 35092:cfe605c54e50
   182       handle THM _ => thm RS @{thm le_boolD}
   182       handle THM _ => thm RS @{thm le_boolD}
   183   in
   183   in
   184     case concl_of thm of
   184     case concl_of thm of
   185       Const ("==", _) $ _ $ _ => eq2mono (thm RS meta_eq_to_obj_eq)
   185       Const ("==", _) $ _ $ _ => eq2mono (thm RS meta_eq_to_obj_eq)
   186     | _ $ (Const ("op =", _) $ _ $ _) => eq2mono thm
   186     | _ $ (Const ("op =", _) $ _ $ _) => eq2mono thm
   187     | _ $ (Const (@{const_name Algebras.less_eq}, _) $ _ $ _) =>
   187     | _ $ (Const (@{const_name Orderings.less_eq}, _) $ _ $ _) =>
   188       dest_less_concl (Seq.hd (REPEAT (FIRSTGOAL
   188       dest_less_concl (Seq.hd (REPEAT (FIRSTGOAL
   189         (resolve_tac [@{thm le_funI}, @{thm le_boolI'}])) thm))
   189         (resolve_tac [@{thm le_funI}, @{thm le_boolI'}])) thm))
   190     | _ => thm
   190     | _ => thm
   191   end handle THM _ =>
   191   end handle THM _ =>
   192     error ("Bad monotonicity theorem:\n" ^ Display.string_of_thm_without_context thm);
   192     error ("Bad monotonicity theorem:\n" ^ Display.string_of_thm_without_context thm);
   559       (map_index (fn (i, P) => fold_rev (curry HOLogic.mk_imp)
   559       (map_index (fn (i, P) => fold_rev (curry HOLogic.mk_imp)
   560          (make_bool_args HOLogic.mk_not I bs i)
   560          (make_bool_args HOLogic.mk_not I bs i)
   561          (list_comb (P, make_args' argTs xs (binder_types (fastype_of P))))) preds));
   561          (list_comb (P, make_args' argTs xs (binder_types (fastype_of P))))) preds));
   562 
   562 
   563     val ind_concl = HOLogic.mk_Trueprop
   563     val ind_concl = HOLogic.mk_Trueprop
   564       (HOLogic.mk_binrel @{const_name Algebras.less_eq} (rec_const, ind_pred));
   564       (HOLogic.mk_binrel @{const_name Orderings.less_eq} (rec_const, ind_pred));
   565 
   565 
   566     val raw_fp_induct = (mono RS (fp_def RS @{thm def_lfp_induct}));
   566     val raw_fp_induct = (mono RS (fp_def RS @{thm def_lfp_induct}));
   567 
   567 
   568     val induct = Skip_Proof.prove ctxt'' [] ind_prems ind_concl
   568     val induct = Skip_Proof.prove ctxt'' [] ind_prems ind_concl
   569       (fn {prems, ...} => EVERY
   569       (fn {prems, ...} => EVERY