--- a/src/Pure/IsaMakefile Wed Mar 08 17:45:16 2000 +0100
+++ b/src/Pure/IsaMakefile Wed Mar 08 17:48:31 2000 +0100
@@ -34,20 +34,20 @@
Isar/isar_thy.ML Isar/local_defs.ML Isar/method.ML Isar/net_rules.ML \
Isar/obtain.ML Isar/outer_lex.ML Isar/outer_parse.ML \
Isar/outer_syntax.ML Isar/proof.ML Isar/proof_context.ML \
- Isar/proof_data.ML Isar/proof_history.ML Isar/session.ML \
- Isar/skip_proof.ML Isar/toplevel.ML ML-Systems/mlworks.ML \
- ML-Systems/polyml.ML ML-Systems/smlnj-0.93.ML ML-Systems/smlnj.ML \
- ROOT.ML Syntax/ROOT.ML Syntax/ast.ML Syntax/lexicon.ML \
- Syntax/mixfix.ML Syntax/parser.ML Syntax/printer.ML \
- Syntax/syn_ext.ML Syntax/syn_trans.ML Syntax/syntax.ML \
- Syntax/token_trans.ML Syntax/type_ext.ML Thy/ROOT.ML Thy/html.ML \
- Thy/latex.ML Thy/present.ML Thy/thm_deps.ML Thy/thm_database.ML \
- Thy/thy_info.ML Thy/thy_load.ML Thy/thy_parse.ML Thy/thy_scan.ML \
- Thy/thy_syn.ML axclass.ML basis.ML context.ML deriv.ML display.ML \
- drule.ML envir.ML goals.ML install_pp.ML library.ML locale.ML \
- logic.ML net.ML pattern.ML pure.ML pure_thy.ML search.ML sign.ML \
- sorts.ML tactic.ML tctical.ML term.ML theory.ML theory_data.ML \
- thm.ML type.ML type_infer.ML unify.ML
+ Isar/proof_data.ML Isar/proof_history.ML Isar/rule_cases.ML \
+ Isar/session.ML Isar/skip_proof.ML Isar/toplevel.ML \
+ ML-Systems/mlworks.ML ML-Systems/polyml.ML ML-Systems/smlnj-0.93.ML \
+ ML-Systems/smlnj.ML ROOT.ML Syntax/ROOT.ML Syntax/ast.ML \
+ Syntax/lexicon.ML Syntax/mixfix.ML Syntax/parser.ML \
+ Syntax/printer.ML Syntax/syn_ext.ML Syntax/syn_trans.ML \
+ Syntax/syntax.ML Syntax/token_trans.ML Syntax/type_ext.ML \
+ Thy/ROOT.ML Thy/html.ML Thy/latex.ML Thy/present.ML Thy/thm_deps.ML \
+ Thy/thm_database.ML Thy/thy_info.ML Thy/thy_load.ML Thy/thy_parse.ML \
+ Thy/thy_scan.ML Thy/thy_syn.ML axclass.ML basis.ML context.ML \
+ deriv.ML display.ML drule.ML envir.ML goals.ML install_pp.ML \
+ library.ML locale.ML logic.ML net.ML pattern.ML pure.ML pure_thy.ML \
+ search.ML sign.ML sorts.ML tactic.ML tctical.ML term.ML theory.ML \
+ theory_data.ML thm.ML type.ML type_infer.ML unify.ML
@./mk
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Pure/Isar/rule_cases.ML Wed Mar 08 17:48:31 2000 +0100
@@ -0,0 +1,75 @@
+(* Title: Pure/Isar/rule_cases.ML
+ ID: $Id$
+ Author: Markus Wenzel, TU Muenchen
+
+Manage local contexts of rules.
+
+TODO:
+ - instantiation of cases (including type vars!);
+*)
+
+signature RULE_CASES =
+sig
+ type T (* = (string * typ) list * term list *)
+ val name: string list -> thm -> thm
+ val get: thm -> string list
+ val add: thm -> thm * string list
+ val none: thm -> thm * string list
+ val make: thm -> string list -> (string * T) list
+ val case_names: string list -> 'a attribute
+ val params: string list list -> 'a attribute
+end;
+
+structure RuleCases: RULE_CASES =
+struct
+
+
+(* local contexts *)
+
+type T = (string * typ) list * term list;
+val casesN = "cases";
+
+
+(* case names *)
+
+fun name names thm =
+ thm
+ |> Drule.untag_rule (casesN, [])
+ |> Drule.tag_rule (casesN, names);
+
+fun get thm =
+ (case assoc (Thm.tags_of_thm thm, casesN) of
+ None => map Library.string_of_int (1 upto Thm.nprems_of thm)
+ | Some names => names);
+
+fun add thm = (thm, get thm);
+fun none thm = (thm, []);
+
+
+(* prepare cases *)
+
+fun prep_case thm name i =
+ let
+ val (_, _, Bi, _) = Thm.dest_state (thm, i)
+ handle THM _ => raise THM ("More cases than premises in rule", 0, [thm]);
+ val rev_params = rename_wrt_term Bi (Logic.strip_params Bi);
+ val rev_frees = map Free rev_params;
+ val props = map (fn t => Term.subst_bounds (rev_frees, t)) (Logic.strip_assums_hyp Bi);
+ in (name, (rev rev_params, props)) end;
+
+fun make thm names =
+ #1 (foldr (fn (name, (cases, i)) => (prep_case thm name i :: cases, i - 1))
+ (Library.drop (length names - Thm.nprems_of thm, names), ([], Thm.nprems_of thm)));
+
+
+(* attributes *)
+
+fun case_names ss = Drule.rule_attribute (K (name ss));
+
+fun rename_params xss thm =
+ #1 (foldl (fn ((th, i), xs) => (Thm.rename_params_rule (xs, i) th, i + 1)) ((thm, 1), xss));
+
+fun params xss = Drule.rule_attribute (K (rename_params xss));
+
+
+end;