(* Title: ZF/Tools/ind_cases.ML ID: $Id$ Author: Markus Wenzel, LMU Muenchen Generic inductive cases facility for (co)inductive definitions. *) signature IND_CASES = sig val declare: string -> (simpset -> cterm -> thm) -> theory -> theory val inductive_cases: (Attrib.binding * string list) list -> theory -> theory val setup: theory -> theory end; structure IndCases: IND_CASES = struct (* theory data *) structure IndCasesData = TheoryDataFun ( type T = (simpset -> cterm -> thm) Symtab.table; val empty = Symtab.empty; val copy = I; val extend = I; fun merge _ tabs : T = Symtab.merge (K true) tabs; ); fun declare name f = IndCasesData.map (Symtab.update (name, f)); fun smart_cases thy ss read_prop s = let fun err msg = cat_error msg ("Malformed set membership statement: " ^ s); val A = read_prop s handle ERROR msg => err msg; val c = #1 (Term.dest_Const (Term.head_of (#2 (Ind_Syntax.dest_mem (FOLogic.dest_Trueprop (Logic.strip_imp_concl A)))))) handle TERM _ => err ""; in (case Symtab.lookup (IndCasesData.get thy) c of NONE => error ("Unknown inductive cases rule for set " ^ quote c) | SOME f => f ss (Thm.cterm_of thy A)) end; (* inductive_cases command *) fun inductive_cases args thy = let val read_prop = Syntax.read_prop (ProofContext.init thy); val mk_cases = smart_cases thy (Simplifier.simpset_of thy) read_prop; val facts = args |> map (fn ((name, srcs), props) => ((name, map (Attrib.attribute thy) srcs), map (Thm.no_attributes o single o mk_cases) props)); in thy |> PureThy.note_thmss "" facts |> snd end; (* ind_cases method *) val setup = Method.setup @{binding "ind_cases"} (Scan.lift (Scan.repeat1 Args.name_source) >> (fn props => fn ctxt => props |> map (smart_cases (ProofContext.theory_of ctxt) (local_simpset_of ctxt) (Syntax.read_prop ctxt)) |> Method.erule 0)) "dynamic case analysis on sets"; (* outer syntax *) local structure P = OuterParse and K = OuterKeyword in val _ = OuterSyntax.command "inductive_cases" "create simplified instances of elimination rules (improper)" K.thy_script (P.and_list1 (SpecParse.opt_thm_name ":" -- Scan.repeat1 P.prop) >> (Toplevel.theory o inductive_cases)); end; end;