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]); |