# HG changeset patch
# User wenzelm
# Date 952534111 -3600
# Node ID 0eb9ee70c8f87ad8191da0225733b11d411380e2
# Parent  242dab4f164a831c78374bc67c7485c5878d8c7a
added Isar/rule_cases.ML;

diff -r 242dab4f164a -r 0eb9ee70c8f8 src/Pure/IsaMakefile
--- 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
 
 
diff -r 242dab4f164a -r 0eb9ee70c8f8 src/Pure/Isar/rule_cases.ML
--- /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;