blob: 11b3af9e488b81ff4c3a35076e0b25756eb724f7 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
|
(* Title: elimination.ML
Author: Joshua Chen
Type elimination setup.
*)
structure Elim: sig
val Rules: Proof.context -> (thm * indexname list) Termtab.table
val rules: Proof.context -> (thm * indexname list) list
val lookup_rule: Proof.context -> Termtab.key -> (thm * indexname list) option
val register_rule: term list -> thm -> Context.generic -> Context.generic
end = struct
(** Context data **)
(* Elimination rule data *)
(*Stores elimination rules together with a list of the indexnames of the
variables each rule eliminates. Keyed by head of the type being eliminated.*)
structure Rules = Generic_Data (
type T = (thm * indexname list) Termtab.table
val empty = Termtab.empty
val extend = I
val merge = Termtab.merge (eq_fst Thm.eq_thm_prop)
)
val Rules = Rules.get o Context.Proof
fun rules ctxt = map (op #2) (Termtab.dest (Rules ctxt))
fun lookup_rule ctxt = Termtab.lookup (Rules ctxt)
fun register_rule tms rl =
let val hd = Term.head_of (Lib.type_of_typing (Thm.major_prem_of rl))
in Rules.map (Termtab.update (hd, (rl, map (#1 o dest_Var) tms))) end
(* [elims] attribute *)
val _ = Theory.setup (
Attrib.setup \<^binding>\<open>elims\<close>
(Scan.repeat Args.term_pattern >>
(Thm.declaration_attribute o register_rule))
""
#> Global_Theory.add_thms_dynamic (\<^binding>\<open>elims\<close>,
fn context => (map #1 (rules (Context.proof_of context))))
)
end
|
