added Isar/rule_cases.ML;
authorwenzelm
Wed Mar 08 17:48:31 2000 +0100 (2000-03-08)
changeset 83640eb9ee70c8f8
parent 8363 242dab4f164a
child 8365 affb2989d238
added Isar/rule_cases.ML;
src/Pure/IsaMakefile
src/Pure/Isar/rule_cases.ML
     1.1 --- a/src/Pure/IsaMakefile	Wed Mar 08 17:45:16 2000 +0100
     1.2 +++ b/src/Pure/IsaMakefile	Wed Mar 08 17:48:31 2000 +0100
     1.3 @@ -34,20 +34,20 @@
     1.4    Isar/isar_thy.ML Isar/local_defs.ML Isar/method.ML Isar/net_rules.ML	\
     1.5    Isar/obtain.ML Isar/outer_lex.ML Isar/outer_parse.ML			\
     1.6    Isar/outer_syntax.ML Isar/proof.ML Isar/proof_context.ML		\
     1.7 -  Isar/proof_data.ML Isar/proof_history.ML Isar/session.ML		\
     1.8 -  Isar/skip_proof.ML Isar/toplevel.ML ML-Systems/mlworks.ML		\
     1.9 -  ML-Systems/polyml.ML ML-Systems/smlnj-0.93.ML ML-Systems/smlnj.ML	\
    1.10 -  ROOT.ML Syntax/ROOT.ML Syntax/ast.ML Syntax/lexicon.ML		\
    1.11 -  Syntax/mixfix.ML Syntax/parser.ML Syntax/printer.ML			\
    1.12 -  Syntax/syn_ext.ML Syntax/syn_trans.ML Syntax/syntax.ML		\
    1.13 -  Syntax/token_trans.ML Syntax/type_ext.ML Thy/ROOT.ML Thy/html.ML	\
    1.14 -  Thy/latex.ML Thy/present.ML Thy/thm_deps.ML Thy/thm_database.ML	\
    1.15 -  Thy/thy_info.ML Thy/thy_load.ML Thy/thy_parse.ML Thy/thy_scan.ML	\
    1.16 -  Thy/thy_syn.ML axclass.ML basis.ML context.ML deriv.ML display.ML	\
    1.17 -  drule.ML envir.ML goals.ML install_pp.ML library.ML locale.ML		\
    1.18 -  logic.ML net.ML pattern.ML pure.ML pure_thy.ML search.ML sign.ML	\
    1.19 -  sorts.ML tactic.ML tctical.ML term.ML theory.ML theory_data.ML	\
    1.20 -  thm.ML type.ML type_infer.ML unify.ML
    1.21 +  Isar/proof_data.ML Isar/proof_history.ML Isar/rule_cases.ML		\
    1.22 +  Isar/session.ML Isar/skip_proof.ML Isar/toplevel.ML			\
    1.23 +  ML-Systems/mlworks.ML ML-Systems/polyml.ML ML-Systems/smlnj-0.93.ML	\
    1.24 +  ML-Systems/smlnj.ML ROOT.ML Syntax/ROOT.ML Syntax/ast.ML		\
    1.25 +  Syntax/lexicon.ML Syntax/mixfix.ML Syntax/parser.ML			\
    1.26 +  Syntax/printer.ML Syntax/syn_ext.ML Syntax/syn_trans.ML		\
    1.27 +  Syntax/syntax.ML Syntax/token_trans.ML Syntax/type_ext.ML		\
    1.28 +  Thy/ROOT.ML Thy/html.ML Thy/latex.ML Thy/present.ML Thy/thm_deps.ML	\
    1.29 +  Thy/thm_database.ML Thy/thy_info.ML Thy/thy_load.ML Thy/thy_parse.ML	\
    1.30 +  Thy/thy_scan.ML Thy/thy_syn.ML axclass.ML basis.ML context.ML		\
    1.31 +  deriv.ML display.ML drule.ML envir.ML goals.ML install_pp.ML		\
    1.32 +  library.ML locale.ML logic.ML net.ML pattern.ML pure.ML pure_thy.ML	\
    1.33 +  search.ML sign.ML sorts.ML tactic.ML tctical.ML term.ML theory.ML	\
    1.34 +  theory_data.ML thm.ML type.ML type_infer.ML unify.ML
    1.35  	@./mk
    1.36  
    1.37  
     2.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.2 +++ b/src/Pure/Isar/rule_cases.ML	Wed Mar 08 17:48:31 2000 +0100
     2.3 @@ -0,0 +1,75 @@
     2.4 +(*  Title:      Pure/Isar/rule_cases.ML
     2.5 +    ID:         $Id$
     2.6 +    Author:     Markus Wenzel, TU Muenchen
     2.7 +
     2.8 +Manage local contexts of rules.
     2.9 +
    2.10 +TODO:
    2.11 +  - instantiation of cases (including type vars!);
    2.12 +*)
    2.13 +
    2.14 +signature RULE_CASES =
    2.15 +sig
    2.16 +  type T (* = (string * typ) list * term list *)
    2.17 +  val name: string list -> thm -> thm
    2.18 +  val get: thm -> string list
    2.19 +  val add: thm -> thm * string list
    2.20 +  val none: thm -> thm * string list
    2.21 +  val make: thm -> string list -> (string * T) list
    2.22 +  val case_names: string list -> 'a attribute
    2.23 +  val params: string list list -> 'a attribute
    2.24 +end;
    2.25 +
    2.26 +structure RuleCases: RULE_CASES =
    2.27 +struct
    2.28 +
    2.29 +
    2.30 +(* local contexts *)
    2.31 +
    2.32 +type T = (string * typ) list * term list;
    2.33 +val casesN = "cases";
    2.34 +
    2.35 +
    2.36 +(* case names *)
    2.37 +
    2.38 +fun name names thm =
    2.39 +  thm
    2.40 +  |> Drule.untag_rule (casesN, [])
    2.41 +  |> Drule.tag_rule (casesN, names);
    2.42 +
    2.43 +fun get thm =
    2.44 +  (case assoc (Thm.tags_of_thm thm, casesN) of
    2.45 +    None => map Library.string_of_int (1 upto Thm.nprems_of thm)
    2.46 +  | Some names => names);
    2.47 +
    2.48 +fun add thm = (thm, get thm);
    2.49 +fun none thm = (thm, []);
    2.50 +
    2.51 +
    2.52 +(* prepare cases *)
    2.53 +
    2.54 +fun prep_case thm name i =
    2.55 +  let
    2.56 +    val (_, _, Bi, _) = Thm.dest_state (thm, i)
    2.57 +      handle THM _ => raise THM ("More cases than premises in rule", 0, [thm]);
    2.58 +    val rev_params = rename_wrt_term Bi (Logic.strip_params Bi);
    2.59 +    val rev_frees = map Free rev_params;
    2.60 +    val props = map (fn t => Term.subst_bounds (rev_frees, t)) (Logic.strip_assums_hyp Bi);
    2.61 +  in (name, (rev rev_params, props)) end;
    2.62 +
    2.63 +fun make thm names =
    2.64 +  #1 (foldr (fn (name, (cases, i)) => (prep_case thm name i :: cases, i - 1))
    2.65 +    (Library.drop (length names - Thm.nprems_of thm, names), ([], Thm.nprems_of thm)));
    2.66 +
    2.67 +
    2.68 +(* attributes *)
    2.69 +
    2.70 +fun case_names ss = Drule.rule_attribute (K (name ss));
    2.71 +
    2.72 +fun rename_params xss thm =
    2.73 +  #1 (foldl (fn ((th, i), xs) => (Thm.rename_params_rule (xs, i) th, i + 1)) ((thm, 1), xss));
    2.74 +
    2.75 +fun params xss = Drule.rule_attribute (K (rename_params xss));
    2.76 +
    2.77 +
    2.78 +end;