src/Pure/Isar/rule_cases.ML
changeset 10530 df079a585e6d
parent 10407 998778f8d63b
child 10811 98f52cb93d93
equal deleted inserted replaced
10529:b92c228660e4 10530:df079a585e6d
     6 Manage local contexts of rules.
     6 Manage local contexts of rules.
     7 *)
     7 *)
     8 
     8 
     9 signature RULE_CASES =
     9 signature RULE_CASES =
    10 sig
    10 sig
    11   type T (* = (string * typ) list * term list *)
    11   val consumes: int -> 'a attribute
       
    12   val consumes_default: int -> 'a attribute
    12   val name: string list -> thm -> thm
    13   val name: string list -> thm -> thm
    13   val case_names: string list -> 'a attribute
    14   val case_names: string list -> 'a attribute
    14   val get: thm -> string list
    15   val get: thm -> string list * int
    15   val add: thm -> thm * string list
    16   val add: thm -> thm * (string list * int)
    16   val none: thm -> thm * string list
    17   val save: thm -> thm -> thm
       
    18   type T (* = (string * typ) list * term list *)
    17   val make: bool -> thm -> string list -> (string * T) list
    19   val make: bool -> thm -> string list -> (string * T) list
    18   val rename_params: string list list -> thm -> thm
    20   val rename_params: string list list -> thm -> thm
    19   val params: string list list -> 'a attribute
    21   val params: string list list -> 'a attribute
    20 end;
    22 end;
    21 
    23 
    22 structure RuleCases: RULE_CASES =
    24 structure RuleCases: RULE_CASES =
    23 struct
    25 struct
    24 
    26 
       
    27 (* number of consumed facts *)
    25 
    28 
    26 (* local contexts *)
    29 val consumesN = "consumes";
    27 
    30 
    28 type T = (string * typ) list * term list;
    31 fun lookup_consumes thm = Library.assoc (Thm.tags_of_thm thm, consumesN);
    29 val casesN = "cases";
    32 
       
    33 fun get_consumes thm =
       
    34   let fun err () = raise THM ("Malformed 'consumes' tag of theorem", 0, [thm]) in
       
    35     (case lookup_consumes thm of
       
    36       None => 0
       
    37     | Some [s] => (case Syntax.read_nat s of Some n => n | _ => err ())
       
    38     | _ => err ())
       
    39   end;
       
    40 
       
    41 fun put_consumes n = Drule.tag_rule (consumesN, [Library.string_of_int n]);
       
    42 val save_consumes = put_consumes o get_consumes;
       
    43 
       
    44 fun consumes n x = Drule.rule_attribute (K (put_consumes n)) x;
       
    45 fun consumes_default n x = if Library.is_some (lookup_consumes (#2 x)) then x else consumes n x;
    30 
    46 
    31 
    47 
    32 (* case names *)
    48 (* case names *)
       
    49 
       
    50 val casesN = "cases";
    33 
    51 
    34 fun name names thm =
    52 fun name names thm =
    35   thm
    53   thm
    36   |> Drule.untag_rule casesN
    54   |> Drule.untag_rule casesN
    37   |> Drule.tag_rule (casesN, names);
    55   |> Drule.tag_rule (casesN, names);
    38 
    56 
       
    57 fun get_case_names thm = Library.assocs (Thm.tags_of_thm thm) casesN;
       
    58 val save_case_names = name o get_case_names;
       
    59 
    39 fun case_names ss = Drule.rule_attribute (K (name ss));
    60 fun case_names ss = Drule.rule_attribute (K (name ss));
    40 
    61 
    41 fun get thm = Library.assocs (Thm.tags_of_thm thm) casesN;
    62 
       
    63 (* access hints *)
       
    64 
       
    65 fun get thm = (get_case_names thm, get_consumes thm);
    42 fun add thm = (thm, get thm);
    66 fun add thm = (thm, get thm);
    43 fun none thm = (thm, []);
    67 
       
    68 fun save thm = save_case_names thm o save_consumes thm;
    44 
    69 
    45 
    70 
    46 (* prepare cases *)
    71 (* prepare cases *)
       
    72 
       
    73 type T = (string * typ) list * term list;
    47 
    74 
    48 fun prep_case open_parms thm name i =
    75 fun prep_case open_parms thm name i =
    49   let
    76   let
    50     val (_, _, Bi, _) = Thm.dest_state (thm, i)
    77     val (_, _, Bi, _) = Thm.dest_state (thm, i)
    51       handle THM _ => raise THM ("More cases than premises in rule", 0, [thm]);
    78       handle THM _ => raise THM ("More cases than premises in rule", 0, [thm]);
    62 
    89 
    63 (* params *)
    90 (* params *)
    64 
    91 
    65 fun rename_params xss thm =
    92 fun rename_params xss thm =
    66   #1 (foldl (fn ((th, i), xs) => (Thm.rename_params_rule (xs, i) th, i + 1)) ((thm, 1), xss))
    93   #1 (foldl (fn ((th, i), xs) => (Thm.rename_params_rule (xs, i) th, i + 1)) ((thm, 1), xss))
    67   |> name (get thm);
    94   |> save thm;
    68 
    95 
    69 fun params xss = Drule.rule_attribute (K (rename_params xss));
    96 fun params xss = Drule.rule_attribute (K (rename_params xss));
    70 
    97 
    71 
    98 
    72 end;
    99 end;