author | haftmann |
Fri, 14 Jun 2019 08:34:28 +0000 | |
changeset 70347 | e5cd5471c18a |
parent 69996 | 8f2d3a27aff0 |
child 70586 | 57df8a85317a |
permissions | -rw-r--r-- |
33374
8099185908a4
Rules that characterize functional/relational specifications.
wenzelm
parents:
diff
changeset
|
1 |
(* Title: Pure/Isar/spec_rules.ML |
8099185908a4
Rules that characterize functional/relational specifications.
wenzelm
parents:
diff
changeset
|
2 |
Author: Makarius |
8099185908a4
Rules that characterize functional/relational specifications.
wenzelm
parents:
diff
changeset
|
3 |
|
33454 | 4 |
Rules that characterize specifications, with rough classification. |
5 |
NB: In the face of arbitrary morphisms, the original shape of |
|
6 |
specifications may get lost. |
|
33374
8099185908a4
Rules that characterize functional/relational specifications.
wenzelm
parents:
diff
changeset
|
7 |
*) |
8099185908a4
Rules that characterize functional/relational specifications.
wenzelm
parents:
diff
changeset
|
8 |
|
8099185908a4
Rules that characterize functional/relational specifications.
wenzelm
parents:
diff
changeset
|
9 |
signature SPEC_RULES = |
8099185908a4
Rules that characterize functional/relational specifications.
wenzelm
parents:
diff
changeset
|
10 |
sig |
69996
8f2d3a27aff0
more informative Spec_Rules.Equational: support corecursion;
wenzelm
parents:
69992
diff
changeset
|
11 |
datatype recursion = |
8f2d3a27aff0
more informative Spec_Rules.Equational: support corecursion;
wenzelm
parents:
69992
diff
changeset
|
12 |
Primrec of string list | Recdef | Primcorec of string list | Corec | Unknown_Recursion |
69992
bd3c10813cc4
more informative Spec_Rules.Equational, notably primrec argument types;
wenzelm
parents:
69991
diff
changeset
|
13 |
val recursion_ord: recursion * recursion -> order |
bd3c10813cc4
more informative Spec_Rules.Equational, notably primrec argument types;
wenzelm
parents:
69991
diff
changeset
|
14 |
datatype rough_classification = Equational of recursion | Inductive | Co_Inductive | Unknown |
69991
6b097aeb3650
clarified signature: avoid direct comparison on type rough_classification;
wenzelm
parents:
67649
diff
changeset
|
15 |
val rough_classification_ord: rough_classification * rough_classification -> order |
69992
bd3c10813cc4
more informative Spec_Rules.Equational, notably primrec argument types;
wenzelm
parents:
69991
diff
changeset
|
16 |
val equational_primrec: string list -> rough_classification |
bd3c10813cc4
more informative Spec_Rules.Equational, notably primrec argument types;
wenzelm
parents:
69991
diff
changeset
|
17 |
val equational_recdef: rough_classification |
69996
8f2d3a27aff0
more informative Spec_Rules.Equational: support corecursion;
wenzelm
parents:
69992
diff
changeset
|
18 |
val equational_primcorec: string list -> rough_classification |
8f2d3a27aff0
more informative Spec_Rules.Equational: support corecursion;
wenzelm
parents:
69992
diff
changeset
|
19 |
val equational_corec: rough_classification |
69992
bd3c10813cc4
more informative Spec_Rules.Equational, notably primrec argument types;
wenzelm
parents:
69991
diff
changeset
|
20 |
val equational: rough_classification |
69991
6b097aeb3650
clarified signature: avoid direct comparison on type rough_classification;
wenzelm
parents:
67649
diff
changeset
|
21 |
val is_equational: rough_classification -> bool |
6b097aeb3650
clarified signature: avoid direct comparison on type rough_classification;
wenzelm
parents:
67649
diff
changeset
|
22 |
val is_inductive: rough_classification -> bool |
6b097aeb3650
clarified signature: avoid direct comparison on type rough_classification;
wenzelm
parents:
67649
diff
changeset
|
23 |
val is_co_inductive: rough_classification -> bool |
6b097aeb3650
clarified signature: avoid direct comparison on type rough_classification;
wenzelm
parents:
67649
diff
changeset
|
24 |
val is_unknown: rough_classification -> bool |
33454 | 25 |
type spec = rough_classification * (term list * thm list) |
26 |
val get: Proof.context -> spec list |
|
27 |
val get_global: theory -> spec list |
|
34948
2d5f2a9f7601
refactoring the predicate compiler; adding theories for Sequences; adding retrieval to Spec_Rules; adding timing to Quickcheck
bulwahn
parents:
33702
diff
changeset
|
28 |
val retrieve: Proof.context -> term -> spec list |
2d5f2a9f7601
refactoring the predicate compiler; adding theories for Sequences; adding retrieval to Spec_Rules; adding timing to Quickcheck
bulwahn
parents:
33702
diff
changeset
|
29 |
val retrieve_global: theory -> term -> spec list |
33454 | 30 |
val add: rough_classification -> term list * thm list -> local_theory -> local_theory |
31 |
val add_global: rough_classification -> term list * thm list -> theory -> theory |
|
33374
8099185908a4
Rules that characterize functional/relational specifications.
wenzelm
parents:
diff
changeset
|
32 |
end; |
8099185908a4
Rules that characterize functional/relational specifications.
wenzelm
parents:
diff
changeset
|
33 |
|
8099185908a4
Rules that characterize functional/relational specifications.
wenzelm
parents:
diff
changeset
|
34 |
structure Spec_Rules: SPEC_RULES = |
8099185908a4
Rules that characterize functional/relational specifications.
wenzelm
parents:
diff
changeset
|
35 |
struct |
8099185908a4
Rules that characterize functional/relational specifications.
wenzelm
parents:
diff
changeset
|
36 |
|
69992
bd3c10813cc4
more informative Spec_Rules.Equational, notably primrec argument types;
wenzelm
parents:
69991
diff
changeset
|
37 |
(* recursion *) |
bd3c10813cc4
more informative Spec_Rules.Equational, notably primrec argument types;
wenzelm
parents:
69991
diff
changeset
|
38 |
|
69996
8f2d3a27aff0
more informative Spec_Rules.Equational: support corecursion;
wenzelm
parents:
69992
diff
changeset
|
39 |
datatype recursion = |
8f2d3a27aff0
more informative Spec_Rules.Equational: support corecursion;
wenzelm
parents:
69992
diff
changeset
|
40 |
Primrec of string list | Recdef | Primcorec of string list | Corec | Unknown_Recursion; |
8f2d3a27aff0
more informative Spec_Rules.Equational: support corecursion;
wenzelm
parents:
69992
diff
changeset
|
41 |
|
8f2d3a27aff0
more informative Spec_Rules.Equational: support corecursion;
wenzelm
parents:
69992
diff
changeset
|
42 |
val recursion_index = |
8f2d3a27aff0
more informative Spec_Rules.Equational: support corecursion;
wenzelm
parents:
69992
diff
changeset
|
43 |
fn Primrec _ => 0 | Recdef => 1 | Primcorec _ => 2 | Corec => 3 | Unknown_Recursion => 4; |
69992
bd3c10813cc4
more informative Spec_Rules.Equational, notably primrec argument types;
wenzelm
parents:
69991
diff
changeset
|
44 |
|
bd3c10813cc4
more informative Spec_Rules.Equational, notably primrec argument types;
wenzelm
parents:
69991
diff
changeset
|
45 |
fun recursion_ord (Primrec Ts1, Primrec Ts2) = list_ord fast_string_ord (Ts1, Ts2) |
69996
8f2d3a27aff0
more informative Spec_Rules.Equational: support corecursion;
wenzelm
parents:
69992
diff
changeset
|
46 |
| recursion_ord (Primcorec Ts1, Primcorec Ts2) = list_ord fast_string_ord (Ts1, Ts2) |
8f2d3a27aff0
more informative Spec_Rules.Equational: support corecursion;
wenzelm
parents:
69992
diff
changeset
|
47 |
| recursion_ord rs = int_ord (apply2 recursion_index rs); |
69992
bd3c10813cc4
more informative Spec_Rules.Equational, notably primrec argument types;
wenzelm
parents:
69991
diff
changeset
|
48 |
|
bd3c10813cc4
more informative Spec_Rules.Equational, notably primrec argument types;
wenzelm
parents:
69991
diff
changeset
|
49 |
|
69991
6b097aeb3650
clarified signature: avoid direct comparison on type rough_classification;
wenzelm
parents:
67649
diff
changeset
|
50 |
(* rough classification *) |
6b097aeb3650
clarified signature: avoid direct comparison on type rough_classification;
wenzelm
parents:
67649
diff
changeset
|
51 |
|
69992
bd3c10813cc4
more informative Spec_Rules.Equational, notably primrec argument types;
wenzelm
parents:
69991
diff
changeset
|
52 |
datatype rough_classification = Equational of recursion | Inductive | Co_Inductive | Unknown; |
bd3c10813cc4
more informative Spec_Rules.Equational, notably primrec argument types;
wenzelm
parents:
69991
diff
changeset
|
53 |
|
bd3c10813cc4
more informative Spec_Rules.Equational, notably primrec argument types;
wenzelm
parents:
69991
diff
changeset
|
54 |
fun rough_classification_ord (Equational r1, Equational r2) = recursion_ord (r1, r2) |
bd3c10813cc4
more informative Spec_Rules.Equational, notably primrec argument types;
wenzelm
parents:
69991
diff
changeset
|
55 |
| rough_classification_ord cs = |
bd3c10813cc4
more informative Spec_Rules.Equational, notably primrec argument types;
wenzelm
parents:
69991
diff
changeset
|
56 |
int_ord (apply2 (fn Equational _ => 0 | Inductive => 1 | Co_Inductive => 2 | Unknown => 3) cs); |
69991
6b097aeb3650
clarified signature: avoid direct comparison on type rough_classification;
wenzelm
parents:
67649
diff
changeset
|
57 |
|
69992
bd3c10813cc4
more informative Spec_Rules.Equational, notably primrec argument types;
wenzelm
parents:
69991
diff
changeset
|
58 |
val equational_primrec = Equational o Primrec; |
bd3c10813cc4
more informative Spec_Rules.Equational, notably primrec argument types;
wenzelm
parents:
69991
diff
changeset
|
59 |
val equational_recdef = Equational Recdef; |
69996
8f2d3a27aff0
more informative Spec_Rules.Equational: support corecursion;
wenzelm
parents:
69992
diff
changeset
|
60 |
val equational_primcorec = Equational o Primcorec; |
8f2d3a27aff0
more informative Spec_Rules.Equational: support corecursion;
wenzelm
parents:
69992
diff
changeset
|
61 |
val equational_corec = Equational Corec; |
69992
bd3c10813cc4
more informative Spec_Rules.Equational, notably primrec argument types;
wenzelm
parents:
69991
diff
changeset
|
62 |
val equational = Equational Unknown_Recursion; |
69991
6b097aeb3650
clarified signature: avoid direct comparison on type rough_classification;
wenzelm
parents:
67649
diff
changeset
|
63 |
|
69992
bd3c10813cc4
more informative Spec_Rules.Equational, notably primrec argument types;
wenzelm
parents:
69991
diff
changeset
|
64 |
val is_equational = fn Equational _ => true | _ => false; |
69991
6b097aeb3650
clarified signature: avoid direct comparison on type rough_classification;
wenzelm
parents:
67649
diff
changeset
|
65 |
val is_inductive = fn Inductive => true | _ => false; |
6b097aeb3650
clarified signature: avoid direct comparison on type rough_classification;
wenzelm
parents:
67649
diff
changeset
|
66 |
val is_co_inductive = fn Co_Inductive => true | _ => false; |
6b097aeb3650
clarified signature: avoid direct comparison on type rough_classification;
wenzelm
parents:
67649
diff
changeset
|
67 |
val is_unknown = fn Unknown => true | _ => false; |
6b097aeb3650
clarified signature: avoid direct comparison on type rough_classification;
wenzelm
parents:
67649
diff
changeset
|
68 |
|
6b097aeb3650
clarified signature: avoid direct comparison on type rough_classification;
wenzelm
parents:
67649
diff
changeset
|
69 |
|
61060 | 70 |
(* rules *) |
33374
8099185908a4
Rules that characterize functional/relational specifications.
wenzelm
parents:
diff
changeset
|
71 |
|
33454 | 72 |
type spec = rough_classification * (term list * thm list); |
33374
8099185908a4
Rules that characterize functional/relational specifications.
wenzelm
parents:
diff
changeset
|
73 |
|
33519 | 74 |
structure Rules = Generic_Data |
33374
8099185908a4
Rules that characterize functional/relational specifications.
wenzelm
parents:
diff
changeset
|
75 |
( |
33454 | 76 |
type T = spec Item_Net.T; |
33374
8099185908a4
Rules that characterize functional/relational specifications.
wenzelm
parents:
diff
changeset
|
77 |
val empty : T = |
8099185908a4
Rules that characterize functional/relational specifications.
wenzelm
parents:
diff
changeset
|
78 |
Item_Net.init |
69992
bd3c10813cc4
more informative Spec_Rules.Equational, notably primrec argument types;
wenzelm
parents:
69991
diff
changeset
|
79 |
(fn ((c1, (ts1, ths1)), (c2, (ts2, ths2))) => |
bd3c10813cc4
more informative Spec_Rules.Equational, notably primrec argument types;
wenzelm
parents:
69991
diff
changeset
|
80 |
is_equal (rough_classification_ord (c1, c2)) andalso |
33454 | 81 |
eq_list (op aconv) (ts1, ts2) andalso |
82 |
eq_list Thm.eq_thm_prop (ths1, ths2)) |
|
83 |
(#1 o #2); |
|
33374
8099185908a4
Rules that characterize functional/relational specifications.
wenzelm
parents:
diff
changeset
|
84 |
val extend = I; |
41472
f6ab14e61604
misc tuning and comments based on review of Theory_Data, Proof_Data, Generic_Data usage;
wenzelm
parents:
34948
diff
changeset
|
85 |
val merge = Item_Net.merge; |
33374
8099185908a4
Rules that characterize functional/relational specifications.
wenzelm
parents:
diff
changeset
|
86 |
); |
8099185908a4
Rules that characterize functional/relational specifications.
wenzelm
parents:
diff
changeset
|
87 |
|
61060 | 88 |
|
89 |
(* get *) |
|
90 |
||
91 |
fun get_generic context = |
|
92 |
let |
|
93 |
val thy = Context.theory_of context; |
|
94 |
val transfer = Global_Theory.transfer_theories thy; |
|
95 |
in Item_Net.content (Rules.get context) |> (map o apsnd o apsnd o map) transfer end; |
|
96 |
||
97 |
val get = get_generic o Context.Proof; |
|
98 |
val get_global = get_generic o Context.Theory; |
|
33374
8099185908a4
Rules that characterize functional/relational specifications.
wenzelm
parents:
diff
changeset
|
99 |
|
61060 | 100 |
|
101 |
(* retrieve *) |
|
102 |
||
103 |
fun retrieve_generic context = |
|
104 |
Item_Net.retrieve (Rules.get context) |
|
67649 | 105 |
#> (map o apsnd o apsnd o map) (Thm.transfer'' context); |
61060 | 106 |
|
107 |
val retrieve = retrieve_generic o Context.Proof; |
|
108 |
val retrieve_global = retrieve_generic o Context.Theory; |
|
109 |
||
110 |
||
111 |
(* add *) |
|
34948
2d5f2a9f7601
refactoring the predicate compiler; adding theories for Sequences; adding retrieval to Spec_Rules; adding timing to Quickcheck
bulwahn
parents:
33702
diff
changeset
|
112 |
|
33702 | 113 |
fun add class (ts, ths) lthy = |
114 |
let |
|
59621
291934bac95e
Thm.cterm_of and Thm.ctyp_of operate on local context;
wenzelm
parents:
59573
diff
changeset
|
115 |
val cts = map (Thm.cterm_of lthy) ts; |
33702 | 116 |
in |
45291
57cd50f98fdc
uniform Local_Theory.declaration with explicit params;
wenzelm
parents:
42360
diff
changeset
|
117 |
lthy |> Local_Theory.declaration {syntax = false, pervasive = true} |
33702 | 118 |
(fn phi => |
119 |
let |
|
120 |
val (ts', ths') = |
|
121 |
Morphism.fact phi (map Drule.mk_term cts @ ths) |
|
122 |
|> chop (length cts) |
|
61060 | 123 |
|>> map (Thm.term_of o Drule.dest_term) |
124 |
||> map Thm.trim_context; |
|
33702 | 125 |
in Rules.map (Item_Net.update (class, (ts', ths'))) end) |
126 |
end; |
|
33374
8099185908a4
Rules that characterize functional/relational specifications.
wenzelm
parents:
diff
changeset
|
127 |
|
33454 | 128 |
fun add_global class spec = |
61060 | 129 |
Context.theory_map (Rules.map (Item_Net.update (class, (apsnd o map) Thm.trim_context spec))); |
33374
8099185908a4
Rules that characterize functional/relational specifications.
wenzelm
parents:
diff
changeset
|
130 |
|
8099185908a4
Rules that characterize functional/relational specifications.
wenzelm
parents:
diff
changeset
|
131 |
end; |