author | wenzelm |
Wed, 07 Aug 2019 15:48:52 +0200 | |
changeset 70482 | d4b5139eea34 |
parent 70480 | 1a1b7d7f24bb |
child 70494 | 41108e3e9ca5 |
permissions | -rw-r--r-- |
250 | 1 |
(* Title: Pure/thm.ML |
2 |
Author: Lawrence C Paulson, Cambridge University Computer Laboratory |
|
29269
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29003
diff
changeset
|
3 |
Author: Makarius |
229
4002c4cd450c
Pure: MAJOR CHANGE. Moved ML types ctyp and cterm and their associated
lcp
parents:
225
diff
changeset
|
4 |
|
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
5 |
The very core of Isabelle's Meta Logic: certified types and terms, |
59589 | 6 |
derivations, theorems, inference rules (including lifting and |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
7 |
resolution), oracles. |
0 | 8 |
*) |
9 |
||
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
10 |
infix 0 RS RSN; |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
11 |
|
6089 | 12 |
signature BASIC_THM = |
59589 | 13 |
sig |
59582 | 14 |
type ctyp |
15 |
type cterm |
|
16 |
exception CTERM of string * cterm list |
|
17 |
type thm |
|
18 |
type conv = cterm -> thm |
|
19 |
exception THM of string * int * thm list |
|
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
20 |
val RSN: thm * (int * thm) -> thm |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
21 |
val RS: thm * thm -> thm |
59582 | 22 |
end; |
23 |
||
24 |
signature THM = |
|
25 |
sig |
|
26 |
include BASIC_THM |
|
1160 | 27 |
(*certified types*) |
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
28 |
val typ_of: ctyp -> typ |
59621
291934bac95e
Thm.cterm_of and Thm.ctyp_of operate on local context;
wenzelm
parents:
59591
diff
changeset
|
29 |
val global_ctyp_of: theory -> typ -> ctyp |
291934bac95e
Thm.cterm_of and Thm.ctyp_of operate on local context;
wenzelm
parents:
59591
diff
changeset
|
30 |
val ctyp_of: Proof.context -> typ -> ctyp |
59582 | 31 |
val dest_ctyp: ctyp -> ctyp list |
70159 | 32 |
val dest_ctypN: int -> ctyp -> ctyp |
33 |
val dest_ctyp0: ctyp -> ctyp |
|
34 |
val dest_ctyp1: ctyp -> ctyp |
|
70156 | 35 |
val make_ctyp: ctyp -> ctyp list -> ctyp |
1160 | 36 |
(*certified terms*) |
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
37 |
val term_of: cterm -> term |
59586 | 38 |
val typ_of_cterm: cterm -> typ |
39 |
val ctyp_of_cterm: cterm -> ctyp |
|
40 |
val maxidx_of_cterm: cterm -> int |
|
59621
291934bac95e
Thm.cterm_of and Thm.ctyp_of operate on local context;
wenzelm
parents:
59591
diff
changeset
|
41 |
val global_cterm_of: theory -> term -> cterm |
291934bac95e
Thm.cterm_of and Thm.ctyp_of operate on local context;
wenzelm
parents:
59591
diff
changeset
|
42 |
val cterm_of: Proof.context -> term -> cterm |
59969
bcccad156236
explicitly checked alpha conversion -- actual renaming happens outside kernel;
wenzelm
parents:
59917
diff
changeset
|
43 |
val renamed_term: term -> cterm -> cterm |
59582 | 44 |
val dest_comb: cterm -> cterm * cterm |
45 |
val dest_fun: cterm -> cterm |
|
46 |
val dest_arg: cterm -> cterm |
|
47 |
val dest_fun2: cterm -> cterm |
|
48 |
val dest_arg1: cterm -> cterm |
|
49 |
val dest_abs: string option -> cterm -> cterm * cterm |
|
60952
762cb38a3147
produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents:
60951
diff
changeset
|
50 |
val rename_tvar: indexname -> ctyp -> ctyp |
60951
b70c4db3874f
produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents:
60949
diff
changeset
|
51 |
val var: indexname * ctyp -> cterm |
59582 | 52 |
val apply: cterm -> cterm -> cterm |
53 |
val lambda_name: string * cterm -> cterm -> cterm |
|
54 |
val lambda: cterm -> cterm -> cterm |
|
55 |
val adjust_maxidx_cterm: int -> cterm -> cterm |
|
56 |
val incr_indexes_cterm: int -> cterm -> cterm |
|
60642
48dd1cefb4ae
simplified Thm.instantiate and derivatives: the LHS refers to non-certified variables -- this merely serves as index into already certified structures (or is ignored);
wenzelm
parents:
60638
diff
changeset
|
57 |
val match: cterm * cterm -> |
48dd1cefb4ae
simplified Thm.instantiate and derivatives: the LHS refers to non-certified variables -- this merely serves as index into already certified structures (or is ignored);
wenzelm
parents:
60638
diff
changeset
|
58 |
((indexname * sort) * ctyp) list * ((indexname * typ) * cterm) list |
48dd1cefb4ae
simplified Thm.instantiate and derivatives: the LHS refers to non-certified variables -- this merely serves as index into already certified structures (or is ignored);
wenzelm
parents:
60638
diff
changeset
|
59 |
val first_order_match: cterm * cterm -> |
48dd1cefb4ae
simplified Thm.instantiate and derivatives: the LHS refers to non-certified variables -- this merely serves as index into already certified structures (or is ignored);
wenzelm
parents:
60638
diff
changeset
|
60 |
((indexname * sort) * ctyp) list * ((indexname * typ) * cterm) list |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
61 |
(*theorems*) |
59582 | 62 |
val fold_terms: (term -> 'a -> 'a) -> thm -> 'a -> 'a |
60952
762cb38a3147
produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents:
60951
diff
changeset
|
63 |
val fold_atomic_ctyps: (ctyp -> 'a -> 'a) -> thm -> 'a -> 'a |
60818 | 64 |
val fold_atomic_cterms: (cterm -> 'a -> 'a) -> thm -> 'a -> 'a |
59582 | 65 |
val terms_of_tpairs: (term * term) list -> term list |
66 |
val full_prop_of: thm -> term |
|
65458 | 67 |
val theory_id: thm -> Context.theory_id |
68 |
val theory_name: thm -> string |
|
59582 | 69 |
val maxidx_of: thm -> int |
70 |
val maxidx_thm: thm -> int -> int |
|
61039 | 71 |
val shyps_of: thm -> sort Ord_List.T |
59582 | 72 |
val hyps_of: thm -> term list |
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
73 |
val prop_of: thm -> term |
59582 | 74 |
val tpairs_of: thm -> (term * term) list |
16656 | 75 |
val concl_of: thm -> term |
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
76 |
val prems_of: thm -> term list |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
77 |
val nprems_of: thm -> int |
59582 | 78 |
val no_prems: thm -> bool |
79 |
val major_prem_of: thm -> term |
|
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
80 |
val cprop_of: thm -> cterm |
18145 | 81 |
val cprem_of: thm -> int -> cterm |
69101
991a3feaf270
more direct implementation of distinct_subgoals_tac -- potentially more efficient;
wenzelm
parents:
68692
diff
changeset
|
82 |
val cconcl_of: thm -> cterm |
991a3feaf270
more direct implementation of distinct_subgoals_tac -- potentially more efficient;
wenzelm
parents:
68692
diff
changeset
|
83 |
val cprems_of: thm -> cterm list |
60949 | 84 |
val chyps_of: thm -> cterm list |
61051 | 85 |
exception CONTEXT of string * ctyp list * cterm list * thm list * Context.generic option |
86 |
val theory_of_cterm: cterm -> theory |
|
87 |
val theory_of_thm: thm -> theory |
|
67697 | 88 |
val trim_context_ctyp: ctyp -> ctyp |
61051 | 89 |
val trim_context_cterm: cterm -> cterm |
70156 | 90 |
val transfer_ctyp: theory -> ctyp -> ctyp |
61051 | 91 |
val transfer_cterm: theory -> cterm -> cterm |
38709 | 92 |
val transfer: theory -> thm -> thm |
67649 | 93 |
val transfer': Proof.context -> thm -> thm |
94 |
val transfer'': Context.generic -> thm -> thm |
|
70310
c82f59c47aaf
clarified transfer_morphism: implicit join_certificate, e.g. relevant for complex cascades of morphisms such as class locale interpretation;
wenzelm
parents:
70159
diff
changeset
|
95 |
val join_transfer: theory -> thm -> thm |
70313 | 96 |
val join_transfer_context: Proof.context * thm -> Proof.context * thm |
59969
bcccad156236
explicitly checked alpha conversion -- actual renaming happens outside kernel;
wenzelm
parents:
59917
diff
changeset
|
97 |
val renamed_prop: term -> thm -> thm |
38709 | 98 |
val weaken: cterm -> thm -> thm |
99 |
val weaken_sorts: sort list -> cterm -> cterm |
|
100 |
val extra_shyps: thm -> sort list |
|
44333
cc53ce50f738
reverted to join_bodies/join_proofs based on fold_body_thms to regain performance (escpecially of HOL-Proofs) -- see also aa9c1e9ef2ce and 4e2abb045eac;
wenzelm
parents:
44331
diff
changeset
|
101 |
val proof_bodies_of: thm list -> proof_body list |
32725 | 102 |
val proof_body_of: thm -> proof_body |
103 |
val proof_of: thm -> proof |
|
66168 | 104 |
val consolidate: thm list -> unit |
50126
3dec88149176
theorem status about oracles/futures is no longer printed by default;
wenzelm
parents:
49008
diff
changeset
|
105 |
val peek_status: thm -> {oracle: bool, unfinished: bool, failed: bool} |
32725 | 106 |
val future: thm future -> cterm -> thm |
64568
a504a3dec35a
more careful derivation_closed / close_derivation;
wenzelm
parents:
63858
diff
changeset
|
107 |
val derivation_closed: thm -> bool |
36744
6e1f3d609a68
renamed Thm.get_name -> Thm.derivation_name and Thm.put_name -> Thm.name_derivation, to emphasize the true nature of these operations;
wenzelm
parents:
36742
diff
changeset
|
108 |
val derivation_name: thm -> string |
6e1f3d609a68
renamed Thm.get_name -> Thm.derivation_name and Thm.put_name -> Thm.name_derivation, to emphasize the true nature of these operations;
wenzelm
parents:
36742
diff
changeset
|
109 |
val name_derivation: string -> thm -> thm |
70404 | 110 |
val close_derivation: thm -> thm |
70480
1a1b7d7f24bb
explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents:
70475
diff
changeset
|
111 |
val trim_context: thm -> thm |
28675
fb68c0767004
renamed get_axiom_i to axiom, removed obsolete get_axiom;
wenzelm
parents:
28648
diff
changeset
|
112 |
val axiom: theory -> string -> thm |
fb68c0767004
renamed get_axiom_i to axiom, removed obsolete get_axiom;
wenzelm
parents:
28648
diff
changeset
|
113 |
val axioms_of: theory -> (string * thm) list |
28017 | 114 |
val get_tags: thm -> Properties.T |
115 |
val map_tags: (Properties.T -> Properties.T) -> thm -> thm |
|
23781
ab793a6ddf9f
Added function norm_proof for normalizing the proof term
berghofe
parents:
23657
diff
changeset
|
116 |
val norm_proof: thm -> thm |
20261 | 117 |
val adjust_maxidx_thm: int -> thm -> thm |
70458 | 118 |
(*type classes*) |
119 |
val the_classrel: theory -> class * class -> thm |
|
120 |
val the_arity: theory -> string * sort list * class -> thm |
|
121 |
val classrel_proof: theory -> class * class -> proof |
|
122 |
val arity_proof: theory -> string * sort list * class -> proof |
|
70454 | 123 |
(*oracles*) |
124 |
val add_oracle: binding * ('a -> cterm) -> theory -> (string * ('a -> thm)) * theory |
|
125 |
val extern_oracles: bool -> Proof.context -> (Markup.T * xstring) list |
|
59589 | 126 |
(*inference rules*) |
38709 | 127 |
val assume: cterm -> thm |
128 |
val implies_intr: cterm -> thm -> thm |
|
129 |
val implies_elim: thm -> thm -> thm |
|
130 |
val forall_intr: cterm -> thm -> thm |
|
131 |
val forall_elim: cterm -> thm -> thm |
|
132 |
val reflexive: cterm -> thm |
|
133 |
val symmetric: thm -> thm |
|
134 |
val transitive: thm -> thm -> thm |
|
135 |
val beta_conversion: bool -> conv |
|
136 |
val eta_conversion: conv |
|
137 |
val eta_long_conversion: conv |
|
138 |
val abstract_rule: string -> cterm -> thm -> thm |
|
139 |
val combination: thm -> thm -> thm |
|
140 |
val equal_intr: thm -> thm -> thm |
|
141 |
val equal_elim: thm -> thm -> thm |
|
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
142 |
val solve_constraints: thm -> thm |
58950
d07464875dd4
optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents:
58946
diff
changeset
|
143 |
val flexflex_rule: Proof.context option -> thm -> thm Seq.seq |
38709 | 144 |
val generalize: string list * string list -> int -> thm -> thm |
67697 | 145 |
val generalize_cterm: string list * string list -> int -> cterm -> cterm |
146 |
val generalize_ctyp: string list -> int -> ctyp -> ctyp |
|
60642
48dd1cefb4ae
simplified Thm.instantiate and derivatives: the LHS refers to non-certified variables -- this merely serves as index into already certified structures (or is ignored);
wenzelm
parents:
60638
diff
changeset
|
147 |
val instantiate: ((indexname * sort) * ctyp) list * ((indexname * typ) * cterm) list -> |
48dd1cefb4ae
simplified Thm.instantiate and derivatives: the LHS refers to non-certified variables -- this merely serves as index into already certified structures (or is ignored);
wenzelm
parents:
60638
diff
changeset
|
148 |
thm -> thm |
48dd1cefb4ae
simplified Thm.instantiate and derivatives: the LHS refers to non-certified variables -- this merely serves as index into already certified structures (or is ignored);
wenzelm
parents:
60638
diff
changeset
|
149 |
val instantiate_cterm: ((indexname * sort) * ctyp) list * ((indexname * typ) * cterm) list -> |
48dd1cefb4ae
simplified Thm.instantiate and derivatives: the LHS refers to non-certified variables -- this merely serves as index into already certified structures (or is ignored);
wenzelm
parents:
60638
diff
changeset
|
150 |
cterm -> cterm |
38709 | 151 |
val trivial: cterm -> thm |
36330
0584e203960e
renamed Drule.unconstrainTs to Thm.unconstrain_allTs to accomdate the version by krauss/schropp;
wenzelm
parents:
35986
diff
changeset
|
152 |
val of_class: ctyp * class -> thm |
36614
b6c031ad3690
minor tuning of Thm.strip_shyps -- no longer pervasive;
wenzelm
parents:
36613
diff
changeset
|
153 |
val strip_shyps: thm -> thm |
36768
46be86127972
just one version of Thm.unconstrainT, which affects all variables;
wenzelm
parents:
36744
diff
changeset
|
154 |
val unconstrainT: thm -> thm |
38709 | 155 |
val varifyT_global': (string * sort) list -> thm -> ((string * sort) * indexname) list * thm |
156 |
val varifyT_global: thm -> thm |
|
36615
88756a5a92fc
renamed Thm.freezeT to Thm.legacy_freezeT -- it is based on Type.legacy_freeze;
wenzelm
parents:
36614
diff
changeset
|
157 |
val legacy_freezeT: thm -> thm |
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
158 |
val plain_prop_of: thm -> term |
59969
bcccad156236
explicitly checked alpha conversion -- actual renaming happens outside kernel;
wenzelm
parents:
59917
diff
changeset
|
159 |
val dest_state: thm * int -> (term * term) list * term list * term * term |
38709 | 160 |
val lift_rule: cterm -> thm -> thm |
161 |
val incr_indexes: int -> thm -> thm |
|
58950
d07464875dd4
optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents:
58946
diff
changeset
|
162 |
val assumption: Proof.context option -> int -> thm -> thm Seq.seq |
31945 | 163 |
val eq_assumption: int -> thm -> thm |
164 |
val rotate_rule: int -> int -> thm -> thm |
|
165 |
val permute_prems: int -> int -> thm -> thm |
|
58950
d07464875dd4
optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents:
58946
diff
changeset
|
166 |
val bicompose: Proof.context option -> {flatten: bool, match: bool, incremented: bool} -> |
52223
5bb6ae8acb87
tuned signature -- more explicit flags for low-level Thm.bicompose;
wenzelm
parents:
52222
diff
changeset
|
167 |
bool * thm * int -> int -> thm -> thm Seq.seq |
58950
d07464875dd4
optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents:
58946
diff
changeset
|
168 |
val biresolution: Proof.context option -> bool -> (bool * thm) list -> int -> thm -> thm Seq.seq |
70475
98b6da301e13
backed out changeset 1b8858f4c393: odd problems e.g. in CAVA_LTL_Modelchecker;
wenzelm
parents:
70472
diff
changeset
|
169 |
val thynames_of_arity: theory -> string * class -> string list |
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
170 |
val add_classrel: thm -> theory -> theory |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
171 |
val add_arity: thm -> theory -> theory |
6089 | 172 |
end; |
173 |
||
32590
95f4f08f950f
replaced opaque signature matching by plain old abstype (again, cf. ac4498f95d1c) -- this recovers pretty printing in SML/NJ and Poly/ML 5.3;
wenzelm
parents:
32198
diff
changeset
|
174 |
structure Thm: THM = |
0 | 175 |
struct |
250 | 176 |
|
387
69f4356d915d
new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents:
309
diff
changeset
|
177 |
(*** Certified terms and types ***) |
69f4356d915d
new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents:
309
diff
changeset
|
178 |
|
250 | 179 |
(** certified types **) |
180 |
||
70453
492cb3aaa562
simplified module structure: back to plain datatype (see 95f4f08f950f and 70019ab5e57f);
wenzelm
parents:
70404
diff
changeset
|
181 |
datatype ctyp = Ctyp of {cert: Context.certificate, T: typ, maxidx: int, sorts: sort Ord_List.T}; |
250 | 182 |
|
183 |
fun typ_of (Ctyp {T, ...}) = T; |
|
184 |
||
59621
291934bac95e
Thm.cterm_of and Thm.ctyp_of operate on local context;
wenzelm
parents:
59591
diff
changeset
|
185 |
fun global_ctyp_of thy raw_T = |
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
186 |
let |
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
187 |
val T = Sign.certify_typ thy raw_T; |
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
188 |
val maxidx = Term.maxidx_of_typ T; |
26640
92e6d3ec91bd
simplified handling of sorts, removed unnecessary universal witness;
wenzelm
parents:
26631
diff
changeset
|
189 |
val sorts = Sorts.insert_typ T []; |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
190 |
in Ctyp {cert = Context.Certificate thy, T = T, maxidx = maxidx, sorts = sorts} end; |
250 | 191 |
|
59621
291934bac95e
Thm.cterm_of and Thm.ctyp_of operate on local context;
wenzelm
parents:
59591
diff
changeset
|
192 |
val ctyp_of = global_ctyp_of o Proof_Context.theory_of; |
291934bac95e
Thm.cterm_of and Thm.ctyp_of operate on local context;
wenzelm
parents:
59591
diff
changeset
|
193 |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
194 |
fun dest_ctyp (Ctyp {cert, T = Type (_, Ts), maxidx, sorts}) = |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
195 |
map (fn T => Ctyp {cert = cert, T = T, maxidx = maxidx, sorts = sorts}) Ts |
16679 | 196 |
| dest_ctyp cT = raise TYPE ("dest_ctyp", [typ_of cT], []); |
15087 | 197 |
|
70159 | 198 |
fun dest_ctypN n (Ctyp {cert, T, maxidx, sorts}) = |
199 |
let fun err () = raise TYPE ("dest_ctypN", [T], []) in |
|
70153
8a23083ac011
prefer exception TYPE, e.g. when used within conversion;
wenzelm
parents:
70150
diff
changeset
|
200 |
(case T of |
8a23083ac011
prefer exception TYPE, e.g. when used within conversion;
wenzelm
parents:
70150
diff
changeset
|
201 |
Type (_, Ts) => |
70159 | 202 |
Ctyp {cert = cert, T = nth Ts n handle General.Subscript => err (), |
70153
8a23083ac011
prefer exception TYPE, e.g. when used within conversion;
wenzelm
parents:
70150
diff
changeset
|
203 |
maxidx = maxidx, sorts = sorts} |
8a23083ac011
prefer exception TYPE, e.g. when used within conversion;
wenzelm
parents:
70150
diff
changeset
|
204 |
| _ => err ()) |
8a23083ac011
prefer exception TYPE, e.g. when used within conversion;
wenzelm
parents:
70150
diff
changeset
|
205 |
end; |
70150 | 206 |
|
70159 | 207 |
val dest_ctyp0 = dest_ctypN 0; |
208 |
val dest_ctyp1 = dest_ctypN 1; |
|
209 |
||
70156 | 210 |
fun join_certificate_ctyp (Ctyp {cert, ...}) cert0 = Context.join_certificate (cert0, cert); |
211 |
fun union_sorts_ctyp (Ctyp {sorts, ...}) sorts0 = Sorts.union sorts0 sorts; |
|
212 |
fun maxidx_ctyp (Ctyp {maxidx, ...}) maxidx0 = Int.max (maxidx0, maxidx); |
|
213 |
||
214 |
fun make_ctyp (Ctyp {cert, T, maxidx = _, sorts = _}) cargs = |
|
215 |
let |
|
216 |
val As = map typ_of cargs; |
|
217 |
fun err () = raise TYPE ("make_ctyp", T :: As, []); |
|
218 |
in |
|
219 |
(case T of |
|
220 |
Type (a, args) => |
|
221 |
Ctyp { |
|
222 |
cert = fold join_certificate_ctyp cargs cert, |
|
223 |
maxidx = fold maxidx_ctyp cargs ~1, |
|
224 |
sorts = fold union_sorts_ctyp cargs [], |
|
225 |
T = if length args = length cargs then Type (a, As) else err ()} |
|
226 |
| _ => err ()) |
|
227 |
end; |
|
228 |
||
229
4002c4cd450c
Pure: MAJOR CHANGE. Moved ML types ctyp and cterm and their associated
lcp
parents:
225
diff
changeset
|
229 |
|
4002c4cd450c
Pure: MAJOR CHANGE. Moved ML types ctyp and cterm and their associated
lcp
parents:
225
diff
changeset
|
230 |
|
250 | 231 |
(** certified terms **) |
229
4002c4cd450c
Pure: MAJOR CHANGE. Moved ML types ctyp and cterm and their associated
lcp
parents:
225
diff
changeset
|
232 |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
233 |
(*certified terms with checked typ, maxidx, and sorts*) |
70453
492cb3aaa562
simplified module structure: back to plain datatype (see 95f4f08f950f and 70019ab5e57f);
wenzelm
parents:
70404
diff
changeset
|
234 |
datatype cterm = |
492cb3aaa562
simplified module structure: back to plain datatype (see 95f4f08f950f and 70019ab5e57f);
wenzelm
parents:
70404
diff
changeset
|
235 |
Cterm of {cert: Context.certificate, t: term, T: typ, maxidx: int, sorts: sort Ord_List.T}; |
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
236 |
|
22584 | 237 |
exception CTERM of string * cterm list; |
16679 | 238 |
|
250 | 239 |
fun term_of (Cterm {t, ...}) = t; |
229
4002c4cd450c
Pure: MAJOR CHANGE. Moved ML types ctyp and cterm and their associated
lcp
parents:
225
diff
changeset
|
240 |
|
59586 | 241 |
fun typ_of_cterm (Cterm {T, ...}) = T; |
242 |
||
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
243 |
fun ctyp_of_cterm (Cterm {cert, T, maxidx, sorts, ...}) = |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
244 |
Ctyp {cert = cert, T = T, maxidx = maxidx, sorts = sorts}; |
2671 | 245 |
|
59586 | 246 |
fun maxidx_of_cterm (Cterm {maxidx, ...}) = maxidx; |
247 |
||
59621
291934bac95e
Thm.cterm_of and Thm.ctyp_of operate on local context;
wenzelm
parents:
59591
diff
changeset
|
248 |
fun global_cterm_of thy tm = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
249 |
let |
18969 | 250 |
val (t, T, maxidx) = Sign.certify_term thy tm; |
26640
92e6d3ec91bd
simplified handling of sorts, removed unnecessary universal witness;
wenzelm
parents:
26631
diff
changeset
|
251 |
val sorts = Sorts.insert_term t []; |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
252 |
in Cterm {cert = Context.Certificate thy, t = t, T = T, maxidx = maxidx, sorts = sorts} end; |
229
4002c4cd450c
Pure: MAJOR CHANGE. Moved ML types ctyp and cterm and their associated
lcp
parents:
225
diff
changeset
|
253 |
|
59621
291934bac95e
Thm.cterm_of and Thm.ctyp_of operate on local context;
wenzelm
parents:
59591
diff
changeset
|
254 |
val cterm_of = global_cterm_of o Proof_Context.theory_of; |
291934bac95e
Thm.cterm_of and Thm.ctyp_of operate on local context;
wenzelm
parents:
59591
diff
changeset
|
255 |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
256 |
fun join_certificate0 (Cterm {cert = cert1, ...}, Cterm {cert = cert2, ...}) = |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
257 |
Context.join_certificate (cert1, cert2); |
60315 | 258 |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
259 |
fun renamed_term t' (Cterm {cert, t, T, maxidx, sorts}) = |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
260 |
if t aconv t' then Cterm {cert = cert, t = t', T = T, maxidx = maxidx, sorts = sorts} |
59969
bcccad156236
explicitly checked alpha conversion -- actual renaming happens outside kernel;
wenzelm
parents:
59917
diff
changeset
|
261 |
else raise TERM ("renamed_term: terms disagree", [t, t']); |
bcccad156236
explicitly checked alpha conversion -- actual renaming happens outside kernel;
wenzelm
parents:
59917
diff
changeset
|
262 |
|
20580
6fb75df09253
added dest_arg, i.e. a tuned version of #2 o dest_comb;
wenzelm
parents:
20548
diff
changeset
|
263 |
|
22909 | 264 |
(* destructors *) |
265 |
||
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
266 |
fun dest_comb (Cterm {t = c $ a, T, cert, maxidx, sorts}) = |
22909 | 267 |
let val A = Term.argument_type_of c 0 in |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
268 |
(Cterm {t = c, T = A --> T, cert = cert, maxidx = maxidx, sorts = sorts}, |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
269 |
Cterm {t = a, T = A, cert = cert, maxidx = maxidx, sorts = sorts}) |
1493
e936723cb94d
added dest_comb, dest_abs and mk_prop for manipulating cterms
clasohm
parents:
1460
diff
changeset
|
270 |
end |
22584 | 271 |
| dest_comb ct = raise CTERM ("dest_comb", [ct]); |
1493
e936723cb94d
added dest_comb, dest_abs and mk_prop for manipulating cterms
clasohm
parents:
1460
diff
changeset
|
272 |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
273 |
fun dest_fun (Cterm {t = c $ _, T, cert, maxidx, sorts}) = |
22909 | 274 |
let val A = Term.argument_type_of c 0 |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
275 |
in Cterm {t = c, T = A --> T, cert = cert, maxidx = maxidx, sorts = sorts} end |
22909 | 276 |
| dest_fun ct = raise CTERM ("dest_fun", [ct]); |
277 |
||
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
278 |
fun dest_arg (Cterm {t = c $ a, T = _, cert, maxidx, sorts}) = |
22909 | 279 |
let val A = Term.argument_type_of c 0 |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
280 |
in Cterm {t = a, T = A, cert = cert, maxidx = maxidx, sorts = sorts} end |
22584 | 281 |
| dest_arg ct = raise CTERM ("dest_arg", [ct]); |
20580
6fb75df09253
added dest_arg, i.e. a tuned version of #2 o dest_comb;
wenzelm
parents:
20548
diff
changeset
|
282 |
|
22909 | 283 |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
284 |
fun dest_fun2 (Cterm {t = c $ _ $ _, T, cert, maxidx, sorts}) = |
22909 | 285 |
let |
286 |
val A = Term.argument_type_of c 0; |
|
287 |
val B = Term.argument_type_of c 1; |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
288 |
in Cterm {t = c, T = A --> B --> T, cert = cert, maxidx = maxidx, sorts = sorts} end |
22909 | 289 |
| dest_fun2 ct = raise CTERM ("dest_fun2", [ct]); |
290 |
||
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
291 |
fun dest_arg1 (Cterm {t = c $ a $ _, T = _, cert, maxidx, sorts}) = |
22909 | 292 |
let val A = Term.argument_type_of c 0 |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
293 |
in Cterm {t = a, T = A, cert = cert, maxidx = maxidx, sorts = sorts} end |
22909 | 294 |
| dest_arg1 ct = raise CTERM ("dest_arg1", [ct]); |
20673 | 295 |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
296 |
fun dest_abs a (Cterm {t = Abs (x, T, t), T = Type ("fun", [_, U]), cert, maxidx, sorts}) = |
18944 | 297 |
let val (y', t') = Term.dest_abs (the_default x a, T, t) in |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
298 |
(Cterm {t = Free (y', T), T = T, cert = cert, maxidx = maxidx, sorts = sorts}, |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
299 |
Cterm {t = t', T = U, cert = cert, maxidx = maxidx, sorts = sorts}) |
1493
e936723cb94d
added dest_comb, dest_abs and mk_prop for manipulating cterms
clasohm
parents:
1460
diff
changeset
|
300 |
end |
22584 | 301 |
| dest_abs _ ct = raise CTERM ("dest_abs", [ct]); |
1493
e936723cb94d
added dest_comb, dest_abs and mk_prop for manipulating cterms
clasohm
parents:
1460
diff
changeset
|
302 |
|
22909 | 303 |
|
304 |
(* constructors *) |
|
305 |
||
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
306 |
fun rename_tvar (a, i) (Ctyp {cert, T, maxidx, sorts}) = |
60952
762cb38a3147
produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents:
60951
diff
changeset
|
307 |
let |
762cb38a3147
produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents:
60951
diff
changeset
|
308 |
val S = |
762cb38a3147
produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents:
60951
diff
changeset
|
309 |
(case T of |
762cb38a3147
produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents:
60951
diff
changeset
|
310 |
TFree (_, S) => S |
762cb38a3147
produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents:
60951
diff
changeset
|
311 |
| TVar (_, S) => S |
762cb38a3147
produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents:
60951
diff
changeset
|
312 |
| _ => raise TYPE ("rename_tvar: no variable", [T], [])); |
762cb38a3147
produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents:
60951
diff
changeset
|
313 |
val _ = if i < 0 then raise TYPE ("rename_tvar: bad index", [TVar ((a, i), S)], []) else (); |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
314 |
in Ctyp {cert = cert, T = TVar ((a, i), S), maxidx = Int.max (i, maxidx), sorts = sorts} end; |
60952
762cb38a3147
produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents:
60951
diff
changeset
|
315 |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
316 |
fun var ((x, i), Ctyp {cert, T, maxidx, sorts}) = |
60951
b70c4db3874f
produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents:
60949
diff
changeset
|
317 |
if i < 0 then raise TERM ("var: bad index", [Var ((x, i), T)]) |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
318 |
else Cterm {cert = cert, t = Var ((x, i), T), T = T, maxidx = Int.max (i, maxidx), sorts = sorts}; |
60951
b70c4db3874f
produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents:
60949
diff
changeset
|
319 |
|
46497
89ccf66aa73d
renamed Thm.capply to Thm.apply, and Thm.cabs to Thm.lambda in conformance with similar operations in structure Term and Logic;
wenzelm
parents:
46475
diff
changeset
|
320 |
fun apply |
16656 | 321 |
(cf as Cterm {t = f, T = Type ("fun", [dty, rty]), maxidx = maxidx1, sorts = sorts1, ...}) |
322 |
(cx as Cterm {t = x, T, maxidx = maxidx2, sorts = sorts2, ...}) = |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
323 |
if T = dty then |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
324 |
Cterm {cert = join_certificate0 (cf, cx), |
16656 | 325 |
t = f $ x, |
326 |
T = rty, |
|
327 |
maxidx = Int.max (maxidx1, maxidx2), |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
328 |
sorts = Sorts.union sorts1 sorts2} |
46497
89ccf66aa73d
renamed Thm.capply to Thm.apply, and Thm.cabs to Thm.lambda in conformance with similar operations in structure Term and Logic;
wenzelm
parents:
46475
diff
changeset
|
329 |
else raise CTERM ("apply: types don't agree", [cf, cx]) |
89ccf66aa73d
renamed Thm.capply to Thm.apply, and Thm.cabs to Thm.lambda in conformance with similar operations in structure Term and Logic;
wenzelm
parents:
46475
diff
changeset
|
330 |
| apply cf cx = raise CTERM ("apply: first arg is not a function", [cf, cx]); |
250 | 331 |
|
46497
89ccf66aa73d
renamed Thm.capply to Thm.apply, and Thm.cabs to Thm.lambda in conformance with similar operations in structure Term and Logic;
wenzelm
parents:
46475
diff
changeset
|
332 |
fun lambda_name |
32198 | 333 |
(x, ct1 as Cterm {t = t1, T = T1, maxidx = maxidx1, sorts = sorts1, ...}) |
16656 | 334 |
(ct2 as Cterm {t = t2, T = T2, maxidx = maxidx2, sorts = sorts2, ...}) = |
32198 | 335 |
let val t = Term.lambda_name (x, t1) t2 in |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
336 |
Cterm {cert = join_certificate0 (ct1, ct2), |
16656 | 337 |
t = t, T = T1 --> T2, |
338 |
maxidx = Int.max (maxidx1, maxidx2), |
|
339 |
sorts = Sorts.union sorts1 sorts2} |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
340 |
end; |
229
4002c4cd450c
Pure: MAJOR CHANGE. Moved ML types ctyp and cterm and their associated
lcp
parents:
225
diff
changeset
|
341 |
|
46497
89ccf66aa73d
renamed Thm.capply to Thm.apply, and Thm.cabs to Thm.lambda in conformance with similar operations in structure Term and Logic;
wenzelm
parents:
46475
diff
changeset
|
342 |
fun lambda t u = lambda_name ("", t) u; |
32198 | 343 |
|
20580
6fb75df09253
added dest_arg, i.e. a tuned version of #2 o dest_comb;
wenzelm
parents:
20548
diff
changeset
|
344 |
|
22909 | 345 |
(* indexes *) |
346 |
||
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
347 |
fun adjust_maxidx_cterm i (ct as Cterm {cert, t, T, maxidx, sorts}) = |
20580
6fb75df09253
added dest_arg, i.e. a tuned version of #2 o dest_comb;
wenzelm
parents:
20548
diff
changeset
|
348 |
if maxidx = i then ct |
6fb75df09253
added dest_arg, i.e. a tuned version of #2 o dest_comb;
wenzelm
parents:
20548
diff
changeset
|
349 |
else if maxidx < i then |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
350 |
Cterm {maxidx = i, cert = cert, t = t, T = T, sorts = sorts} |
20580
6fb75df09253
added dest_arg, i.e. a tuned version of #2 o dest_comb;
wenzelm
parents:
20548
diff
changeset
|
351 |
else |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
352 |
Cterm {maxidx = Int.max (maxidx_of_term t, i), cert = cert, t = t, T = T, sorts = sorts}; |
20580
6fb75df09253
added dest_arg, i.e. a tuned version of #2 o dest_comb;
wenzelm
parents:
20548
diff
changeset
|
353 |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
354 |
fun incr_indexes_cterm i (ct as Cterm {cert, t, T, maxidx, sorts}) = |
22909 | 355 |
if i < 0 then raise CTERM ("negative increment", [ct]) |
356 |
else if i = 0 then ct |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
357 |
else Cterm {cert = cert, t = Logic.incr_indexes ([], [], i) t, |
22909 | 358 |
T = Logic.incr_tvar i T, maxidx = maxidx + i, sorts = sorts}; |
359 |
||
360 |
||
2509 | 361 |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
362 |
(*** Derivations and Theorems ***) |
229
4002c4cd450c
Pure: MAJOR CHANGE. Moved ML types ctyp and cterm and their associated
lcp
parents:
225
diff
changeset
|
363 |
|
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
364 |
(* sort constraints *) |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
365 |
|
70480
1a1b7d7f24bb
explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents:
70475
diff
changeset
|
366 |
type constraint = {theory: theory, typ: typ, sort: sort}; |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
367 |
|
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
368 |
local |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
369 |
|
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
370 |
val constraint_ord : constraint * constraint -> order = |
70480
1a1b7d7f24bb
explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents:
70475
diff
changeset
|
371 |
Context.theory_id_ord o apply2 (Context.theory_id o #theory) |
1a1b7d7f24bb
explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents:
70475
diff
changeset
|
372 |
<<< Term_Ord.typ_ord o apply2 #typ |
1a1b7d7f24bb
explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents:
70475
diff
changeset
|
373 |
<<< Term_Ord.sort_ord o apply2 #sort; |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
374 |
|
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
375 |
val smash_atyps = |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
376 |
map_atyps (fn TVar (_, S) => Term.aT S | TFree (_, S) => Term.aT S | T => T); |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
377 |
|
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
378 |
in |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
379 |
|
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
380 |
val union_constraints = Ord_List.union constraint_ord; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
381 |
|
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
382 |
fun insert_constraints thy (T, S) = |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
383 |
let |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
384 |
val ignored = |
70463
d6622add8b54
guard constraints by record_proofs=1, until performance implications have become more clear;
wenzelm
parents:
70462
diff
changeset
|
385 |
! Proofterm.proofs < 1 orelse |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
386 |
S = [] orelse |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
387 |
(case T of |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
388 |
TFree (_, S') => S = S' |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
389 |
| TVar (_, S') => S = S' |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
390 |
| _ => false); |
70480
1a1b7d7f24bb
explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents:
70475
diff
changeset
|
391 |
in |
1a1b7d7f24bb
explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents:
70475
diff
changeset
|
392 |
if ignored then I |
1a1b7d7f24bb
explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents:
70475
diff
changeset
|
393 |
else Ord_List.insert constraint_ord {theory = thy, typ = smash_atyps T, sort = S} |
1a1b7d7f24bb
explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents:
70475
diff
changeset
|
394 |
end; |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
395 |
|
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
396 |
fun insert_constraints_env thy env = |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
397 |
let |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
398 |
val tyenv = Envir.type_env env; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
399 |
fun insert ([], _) = I |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
400 |
| insert (S, T) = insert_constraints thy (Envir.norm_type tyenv T, S); |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
401 |
in tyenv |> Vartab.fold (insert o #2) end; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
402 |
|
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
403 |
end; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
404 |
|
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
405 |
|
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
406 |
(* datatype thm *) |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
407 |
|
70453
492cb3aaa562
simplified module structure: back to plain datatype (see 95f4f08f950f and 70019ab5e57f);
wenzelm
parents:
70404
diff
changeset
|
408 |
datatype thm = Thm of |
40124 | 409 |
deriv * (*derivation*) |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
410 |
{cert: Context.certificate, (*background theory certificate*) |
40124 | 411 |
tags: Properties.T, (*additional annotations/comments*) |
412 |
maxidx: int, (*maximum index of any Var or TVar*) |
|
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
413 |
constraints: constraint Ord_List.T, (*implicit proof obligations for sort constraints*) |
40124 | 414 |
shyps: sort Ord_List.T, (*sort hypotheses*) |
415 |
hyps: term Ord_List.T, (*hypotheses*) |
|
416 |
tpairs: (term * term) list, (*flex-flex pairs*) |
|
417 |
prop: term} (*conclusion*) |
|
28624 | 418 |
and deriv = Deriv of |
39687 | 419 |
{promises: (serial * thm future) Ord_List.T, |
70453
492cb3aaa562
simplified module structure: back to plain datatype (see 95f4f08f950f and 70019ab5e57f);
wenzelm
parents:
70404
diff
changeset
|
420 |
body: Proofterm.proof_body}; |
0 | 421 |
|
23601 | 422 |
type conv = cterm -> thm; |
423 |
||
16725 | 424 |
(*errors involving theorems*) |
425 |
exception THM of string * int * thm list; |
|
13658
c9ad3e64ddcf
Changed handling of flex-flex constraints: now stored in separate
berghofe
parents:
13642
diff
changeset
|
426 |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
427 |
fun rep_thm (Thm (_, args)) = args; |
0 | 428 |
|
31947
7daee3bed3af
clarified strip_shyps: proper type witnesses for present sorts;
wenzelm
parents:
31945
diff
changeset
|
429 |
fun fold_terms f (Thm (_, {tpairs, prop, hyps, ...})) = |
7daee3bed3af
clarified strip_shyps: proper type witnesses for present sorts;
wenzelm
parents:
31945
diff
changeset
|
430 |
fold (fn (t, u) => f t #> f u) tpairs #> f prop #> fold f hyps; |
7daee3bed3af
clarified strip_shyps: proper type witnesses for present sorts;
wenzelm
parents:
31945
diff
changeset
|
431 |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
432 |
fun fold_atomic_ctyps f (th as Thm (_, {cert, maxidx, shyps, ...})) = |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
433 |
let fun ctyp T = Ctyp {cert = cert, T = T, maxidx = maxidx, sorts = shyps} |
60952
762cb38a3147
produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents:
60951
diff
changeset
|
434 |
in (fold_terms o fold_types o fold_atyps) (f o ctyp) th end; |
762cb38a3147
produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents:
60951
diff
changeset
|
435 |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
436 |
fun fold_atomic_cterms f (th as Thm (_, {cert, maxidx, shyps, ...})) = |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
437 |
let fun cterm t T = Cterm {cert = cert, t = t, T = T, maxidx = maxidx, sorts = shyps} in |
60818 | 438 |
(fold_terms o fold_aterms) |
439 |
(fn t as Const (_, T) => f (cterm t T) |
|
440 |
| t as Free (_, T) => f (cterm t T) |
|
441 |
| t as Var (_, T) => f (cterm t T) |
|
442 |
| _ => I) th |
|
443 |
end; |
|
444 |
||
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
445 |
|
16725 | 446 |
fun terms_of_tpairs tpairs = fold_rev (fn (t, u) => cons t o cons u) tpairs []; |
447 |
||
448 |
fun eq_tpairs ((t, u), (t', u')) = t aconv t' andalso u aconv u'; |
|
18944 | 449 |
fun union_tpairs ts us = Library.merge eq_tpairs (ts, us); |
16884
1678a796b6b2
tuned instantiate (avoid subst_atomic, subst_atomic_types);
wenzelm
parents:
16847
diff
changeset
|
450 |
val maxidx_tpairs = fold (fn (t, u) => Term.maxidx_term t #> Term.maxidx_term u); |
16725 | 451 |
|
452 |
fun attach_tpairs tpairs prop = |
|
453 |
Logic.list_implies (map Logic.mk_equals tpairs, prop); |
|
454 |
||
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
455 |
fun full_prop_of (Thm (_, {tpairs, prop, ...})) = attach_tpairs tpairs prop; |
16945 | 456 |
|
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
457 |
|
39687 | 458 |
val union_hyps = Ord_List.union Term_Ord.fast_term_ord; |
459 |
val insert_hyps = Ord_List.insert Term_Ord.fast_term_ord; |
|
460 |
val remove_hyps = Ord_List.remove Term_Ord.fast_term_ord; |
|
22365 | 461 |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
462 |
fun join_certificate1 (Cterm {cert = cert1, ...}, Thm (_, {cert = cert2, ...})) = |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
463 |
Context.join_certificate (cert1, cert2); |
16945 | 464 |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
465 |
fun join_certificate2 (Thm (_, {cert = cert1, ...}), Thm (_, {cert = cert2, ...})) = |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
466 |
Context.join_certificate (cert1, cert2); |
16945 | 467 |
|
0 | 468 |
|
22365 | 469 |
(* basic components *) |
16135 | 470 |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
471 |
val cert_of = #cert o rep_thm; |
65458 | 472 |
val theory_id = Context.certificate_theory_id o cert_of; |
473 |
val theory_name = Context.theory_id_name o theory_id; |
|
61050 | 474 |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
475 |
val maxidx_of = #maxidx o rep_thm; |
19910 | 476 |
fun maxidx_thm th i = Int.max (maxidx_of th, i); |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
477 |
val constraints_of = #constraints o rep_thm; |
61039 | 478 |
val shyps_of = #shyps o rep_thm; |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
479 |
val hyps_of = #hyps o rep_thm; |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
480 |
val prop_of = #prop o rep_thm; |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
481 |
val tpairs_of = #tpairs o rep_thm; |
0 | 482 |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
483 |
val concl_of = Logic.strip_imp_concl o prop_of; |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
484 |
val prems_of = Logic.strip_imp_prems o prop_of; |
21576 | 485 |
val nprems_of = Logic.count_prems o prop_of; |
19305 | 486 |
fun no_prems th = nprems_of th = 0; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
487 |
|
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
488 |
fun major_prem_of th = |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
489 |
(case prems_of th of |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
490 |
prem :: _ => Logic.strip_assums_concl prem |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
491 |
| [] => raise THM ("major_prem_of: rule with no premises", 0, [th])); |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
492 |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
493 |
fun cprop_of (Thm (_, {cert, maxidx, shyps, prop, ...})) = |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
494 |
Cterm {cert = cert, maxidx = maxidx, T = propT, t = prop, sorts = shyps}; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
495 |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
496 |
fun cprem_of (th as Thm (_, {cert, maxidx, shyps, prop, ...})) i = |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
497 |
Cterm {cert = cert, maxidx = maxidx, T = propT, sorts = shyps, |
18145 | 498 |
t = Logic.nth_prem (i, prop) handle TERM _ => raise THM ("cprem_of", i, [th])}; |
18035 | 499 |
|
69101
991a3feaf270
more direct implementation of distinct_subgoals_tac -- potentially more efficient;
wenzelm
parents:
68692
diff
changeset
|
500 |
fun cconcl_of (th as Thm (_, {cert, maxidx, shyps, ...})) = |
991a3feaf270
more direct implementation of distinct_subgoals_tac -- potentially more efficient;
wenzelm
parents:
68692
diff
changeset
|
501 |
Cterm {cert = cert, maxidx = maxidx, T = propT, sorts = shyps, t = concl_of th}; |
991a3feaf270
more direct implementation of distinct_subgoals_tac -- potentially more efficient;
wenzelm
parents:
68692
diff
changeset
|
502 |
|
991a3feaf270
more direct implementation of distinct_subgoals_tac -- potentially more efficient;
wenzelm
parents:
68692
diff
changeset
|
503 |
fun cprems_of (th as Thm (_, {cert, maxidx, shyps, ...})) = |
991a3feaf270
more direct implementation of distinct_subgoals_tac -- potentially more efficient;
wenzelm
parents:
68692
diff
changeset
|
504 |
map (fn t => Cterm {cert = cert, maxidx = maxidx, T = propT, sorts = shyps, t = t}) |
991a3feaf270
more direct implementation of distinct_subgoals_tac -- potentially more efficient;
wenzelm
parents:
68692
diff
changeset
|
505 |
(prems_of th); |
991a3feaf270
more direct implementation of distinct_subgoals_tac -- potentially more efficient;
wenzelm
parents:
68692
diff
changeset
|
506 |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
507 |
fun chyps_of (Thm (_, {cert, shyps, hyps, ...})) = |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
508 |
map (fn t => Cterm {cert = cert, maxidx = ~1, T = propT, sorts = shyps, t = t}) hyps; |
60949 | 509 |
|
61051 | 510 |
|
511 |
(* implicit theory context *) |
|
512 |
||
513 |
exception CONTEXT of string * ctyp list * cterm list * thm list * Context.generic option; |
|
514 |
||
515 |
fun theory_of_cterm (ct as Cterm {cert, ...}) = |
|
516 |
Context.certificate_theory cert |
|
517 |
handle ERROR msg => raise CONTEXT (msg, [], [ct], [], NONE); |
|
518 |
||
519 |
fun theory_of_thm th = |
|
520 |
Context.certificate_theory (cert_of th) |
|
521 |
handle ERROR msg => raise CONTEXT (msg, [], [], [th], NONE); |
|
522 |
||
67697 | 523 |
fun trim_context_ctyp cT = |
524 |
(case cT of |
|
525 |
Ctyp {cert = Context.Certificate_Id _, ...} => cT |
|
526 |
| Ctyp {cert = Context.Certificate thy, T, maxidx, sorts} => |
|
527 |
Ctyp {cert = Context.Certificate_Id (Context.theory_id thy), |
|
528 |
T = T, maxidx = maxidx, sorts = sorts}); |
|
529 |
||
61051 | 530 |
fun trim_context_cterm ct = |
531 |
(case ct of |
|
532 |
Cterm {cert = Context.Certificate_Id _, ...} => ct |
|
533 |
| Cterm {cert = Context.Certificate thy, t, T, maxidx, sorts} => |
|
534 |
Cterm {cert = Context.Certificate_Id (Context.theory_id thy), |
|
535 |
t = t, T = T, maxidx = maxidx, sorts = sorts}); |
|
536 |
||
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
537 |
fun trim_context_thm th = |
61048 | 538 |
(case th of |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
539 |
Thm (_, {constraints = _ :: _, ...}) => |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
540 |
raise THM ("trim_context: pending sort constraints", 0, [th]) |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
541 |
| Thm (_, {cert = Context.Certificate_Id _, ...}) => th |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
542 |
| Thm (der, |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
543 |
{cert = Context.Certificate thy, tags, maxidx, constraints = [], shyps, hyps, |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
544 |
tpairs, prop}) => |
61048 | 545 |
Thm (der, |
546 |
{cert = Context.Certificate_Id (Context.theory_id thy), |
|
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
547 |
tags = tags, maxidx = maxidx, constraints = [], shyps = shyps, hyps = hyps, |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
548 |
tpairs = tpairs, prop = prop})); |
61048 | 549 |
|
70156 | 550 |
fun transfer_ctyp thy' cT = |
551 |
let |
|
552 |
val Ctyp {cert, T, maxidx, sorts} = cT; |
|
553 |
val _ = |
|
554 |
Context.subthy_id (Context.certificate_theory_id cert, Context.theory_id thy') orelse |
|
555 |
raise CONTEXT ("Cannot transfer: not a super theory", [cT], [], [], |
|
556 |
SOME (Context.Theory thy')); |
|
557 |
val cert' = Context.join_certificate (Context.Certificate thy', cert); |
|
558 |
in |
|
559 |
if Context.eq_certificate (cert, cert') then cT |
|
560 |
else Ctyp {cert = cert', T = T, maxidx = maxidx, sorts = sorts} |
|
561 |
end; |
|
562 |
||
61051 | 563 |
fun transfer_cterm thy' ct = |
3895 | 564 |
let |
61051 | 565 |
val Cterm {cert, t, T, maxidx, sorts} = ct; |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
566 |
val _ = |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
567 |
Context.subthy_id (Context.certificate_theory_id cert, Context.theory_id thy') orelse |
61051 | 568 |
raise CONTEXT ("Cannot transfer: not a super theory", [], [ct], [], |
569 |
SOME (Context.Theory thy')); |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
570 |
val cert' = Context.join_certificate (Context.Certificate thy', cert); |
3895 | 571 |
in |
61051 | 572 |
if Context.eq_certificate (cert, cert') then ct |
573 |
else Cterm {cert = cert', t = t, T = T, maxidx = maxidx, sorts = sorts} |
|
574 |
end; |
|
575 |
||
576 |
fun transfer thy' th = |
|
577 |
let |
|
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
578 |
val Thm (der, {cert, tags, maxidx, constraints, shyps, hyps, tpairs, prop}) = th; |
61051 | 579 |
val _ = |
580 |
Context.subthy_id (Context.certificate_theory_id cert, Context.theory_id thy') orelse |
|
581 |
raise CONTEXT ("Cannot transfer: not a super theory", [], [], [th], |
|
582 |
SOME (Context.Theory thy')); |
|
583 |
val cert' = Context.join_certificate (Context.Certificate thy', cert); |
|
584 |
in |
|
585 |
if Context.eq_certificate (cert, cert') then th |
|
16945 | 586 |
else |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
587 |
Thm (der, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
588 |
{cert = cert', |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
589 |
tags = tags, |
16945 | 590 |
maxidx = maxidx, |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
591 |
constraints = constraints, |
16945 | 592 |
shyps = shyps, |
593 |
hyps = hyps, |
|
594 |
tpairs = tpairs, |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
595 |
prop = prop}) |
3895 | 596 |
end; |
387
69f4356d915d
new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents:
309
diff
changeset
|
597 |
|
67649 | 598 |
val transfer' = transfer o Proof_Context.theory_of; |
599 |
val transfer'' = transfer o Context.theory_of; |
|
600 |
||
70310
c82f59c47aaf
clarified transfer_morphism: implicit join_certificate, e.g. relevant for complex cascades of morphisms such as class locale interpretation;
wenzelm
parents:
70159
diff
changeset
|
601 |
fun join_transfer thy th = |
c82f59c47aaf
clarified transfer_morphism: implicit join_certificate, e.g. relevant for complex cascades of morphisms such as class locale interpretation;
wenzelm
parents:
70159
diff
changeset
|
602 |
if Context.subthy_id (Context.theory_id thy, theory_id th) then th |
c82f59c47aaf
clarified transfer_morphism: implicit join_certificate, e.g. relevant for complex cascades of morphisms such as class locale interpretation;
wenzelm
parents:
70159
diff
changeset
|
603 |
else transfer thy th; |
c82f59c47aaf
clarified transfer_morphism: implicit join_certificate, e.g. relevant for complex cascades of morphisms such as class locale interpretation;
wenzelm
parents:
70159
diff
changeset
|
604 |
|
70313 | 605 |
fun join_transfer_context (ctxt, th) = |
606 |
if Context.subthy_id (Context.theory_id (Proof_Context.theory_of ctxt), theory_id th) then |
|
607 |
(Context.raw_transfer (theory_of_thm th) ctxt, th) |
|
608 |
else (ctxt, transfer' ctxt th); |
|
609 |
||
61051 | 610 |
|
611 |
(* matching *) |
|
612 |
||
613 |
local |
|
614 |
||
615 |
fun gen_match match |
|
616 |
(ct1 as Cterm {t = t1, sorts = sorts1, ...}, |
|
617 |
ct2 as Cterm {t = t2, sorts = sorts2, maxidx = maxidx2, ...}) = |
|
618 |
let |
|
619 |
val cert = join_certificate0 (ct1, ct2); |
|
620 |
val thy = Context.certificate_theory cert |
|
621 |
handle ERROR msg => raise CONTEXT (msg, [], [ct1, ct2], [], NONE); |
|
622 |
val (Tinsts, tinsts) = match thy (t1, t2) (Vartab.empty, Vartab.empty); |
|
623 |
val sorts = Sorts.union sorts1 sorts2; |
|
624 |
fun mk_cTinst ((a, i), (S, T)) = |
|
625 |
(((a, i), S), Ctyp {T = T, cert = cert, maxidx = maxidx2, sorts = sorts}); |
|
626 |
fun mk_ctinst ((x, i), (U, t)) = |
|
627 |
let val T = Envir.subst_type Tinsts U in |
|
628 |
(((x, i), T), Cterm {t = t, T = T, cert = cert, maxidx = maxidx2, sorts = sorts}) |
|
629 |
end; |
|
630 |
in (Vartab.fold (cons o mk_cTinst) Tinsts [], Vartab.fold (cons o mk_ctinst) tinsts []) end; |
|
631 |
||
632 |
in |
|
633 |
||
634 |
val match = gen_match Pattern.match; |
|
635 |
val first_order_match = gen_match Pattern.first_order_match; |
|
636 |
||
637 |
end; |
|
638 |
||
639 |
||
59969
bcccad156236
explicitly checked alpha conversion -- actual renaming happens outside kernel;
wenzelm
parents:
59917
diff
changeset
|
640 |
(*implicit alpha-conversion*) |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
641 |
fun renamed_prop prop' (Thm (der, {cert, tags, maxidx, constraints, shyps, hyps, tpairs, prop})) = |
59969
bcccad156236
explicitly checked alpha conversion -- actual renaming happens outside kernel;
wenzelm
parents:
59917
diff
changeset
|
642 |
if prop aconv prop' then |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
643 |
Thm (der, {cert = cert, tags = tags, maxidx = maxidx, constraints = constraints, shyps = shyps, |
59969
bcccad156236
explicitly checked alpha conversion -- actual renaming happens outside kernel;
wenzelm
parents:
59917
diff
changeset
|
644 |
hyps = hyps, tpairs = tpairs, prop = prop'}) |
bcccad156236
explicitly checked alpha conversion -- actual renaming happens outside kernel;
wenzelm
parents:
59917
diff
changeset
|
645 |
else raise TERM ("renamed_prop: props disagree", [prop, prop']); |
bcccad156236
explicitly checked alpha conversion -- actual renaming happens outside kernel;
wenzelm
parents:
59917
diff
changeset
|
646 |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
647 |
fun make_context ths NONE cert = |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
648 |
(Context.Theory (Context.certificate_theory cert) |
61051 | 649 |
handle ERROR msg => raise CONTEXT (msg, [], [], ths, NONE)) |
61045
c7a7f063704a
clarified exceptions: avoid interference of formal context failure with regular rule application failure (which is routinely handled in user-space);
wenzelm
parents:
61044
diff
changeset
|
650 |
| make_context ths (SOME ctxt) cert = |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
651 |
let |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
652 |
val thy_id = Context.certificate_theory_id cert; |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
653 |
val thy_id' = Context.theory_id (Proof_Context.theory_of ctxt); |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
654 |
in |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
655 |
if Context.subthy_id (thy_id, thy_id') then Context.Proof ctxt |
61051 | 656 |
else raise CONTEXT ("Bad context", [], [], ths, SOME (Context.Proof ctxt)) |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
657 |
end; |
58950
d07464875dd4
optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents:
58946
diff
changeset
|
658 |
|
64981
ea6199b23dfa
proper background certificate from make_context, which can be a super-theory of the direct join (amending d07464875dd4);
wenzelm
parents:
64574
diff
changeset
|
659 |
fun make_context_certificate ths opt_ctxt cert = |
ea6199b23dfa
proper background certificate from make_context, which can be a super-theory of the direct join (amending d07464875dd4);
wenzelm
parents:
64574
diff
changeset
|
660 |
let |
ea6199b23dfa
proper background certificate from make_context, which can be a super-theory of the direct join (amending d07464875dd4);
wenzelm
parents:
64574
diff
changeset
|
661 |
val context = make_context ths opt_ctxt cert; |
ea6199b23dfa
proper background certificate from make_context, which can be a super-theory of the direct join (amending d07464875dd4);
wenzelm
parents:
64574
diff
changeset
|
662 |
val cert' = Context.Certificate (Context.theory_of context); |
ea6199b23dfa
proper background certificate from make_context, which can be a super-theory of the direct join (amending d07464875dd4);
wenzelm
parents:
64574
diff
changeset
|
663 |
in (context, cert') end; |
ea6199b23dfa
proper background certificate from make_context, which can be a super-theory of the direct join (amending d07464875dd4);
wenzelm
parents:
64574
diff
changeset
|
664 |
|
16945 | 665 |
(*explicit weakening: maps |- B to A |- B*) |
666 |
fun weaken raw_ct th = |
|
667 |
let |
|
20261 | 668 |
val ct as Cterm {t = A, T, sorts, maxidx = maxidxA, ...} = adjust_maxidx_cterm ~1 raw_ct; |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
669 |
val Thm (der, {tags, maxidx, constraints, shyps, hyps, tpairs, prop, ...}) = th; |
16945 | 670 |
in |
671 |
if T <> propT then |
|
672 |
raise THM ("weaken: assumptions must have type prop", 0, []) |
|
673 |
else if maxidxA <> ~1 then |
|
674 |
raise THM ("weaken: assumptions may not contain schematic variables", maxidxA, []) |
|
675 |
else |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
676 |
Thm (der, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
677 |
{cert = join_certificate1 (ct, th), |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
678 |
tags = tags, |
16945 | 679 |
maxidx = maxidx, |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
680 |
constraints = constraints, |
16945 | 681 |
shyps = Sorts.union sorts shyps, |
28354 | 682 |
hyps = insert_hyps A hyps, |
16945 | 683 |
tpairs = tpairs, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
684 |
prop = prop}) |
16945 | 685 |
end; |
16656 | 686 |
|
28624 | 687 |
fun weaken_sorts raw_sorts ct = |
688 |
let |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
689 |
val Cterm {cert, t, T, maxidx, sorts} = ct; |
61050 | 690 |
val thy = theory_of_cterm ct; |
28624 | 691 |
val more_sorts = Sorts.make (map (Sign.certify_sort thy) raw_sorts); |
692 |
val sorts' = Sorts.union sorts more_sorts; |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
693 |
in Cterm {cert = cert, t = t, T = T, maxidx = maxidx, sorts = sorts'} end; |
28624 | 694 |
|
16656 | 695 |
(*dangling sort constraints of a thm*) |
31947
7daee3bed3af
clarified strip_shyps: proper type witnesses for present sorts;
wenzelm
parents:
31945
diff
changeset
|
696 |
fun extra_shyps (th as Thm (_, {shyps, ...})) = |
7daee3bed3af
clarified strip_shyps: proper type witnesses for present sorts;
wenzelm
parents:
31945
diff
changeset
|
697 |
Sorts.subtract (fold_terms Sorts.insert_term th []) shyps; |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
698 |
|
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
699 |
|
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
700 |
|
32725 | 701 |
(** derivations and promised proofs **) |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
702 |
|
32059
7991cdf10a54
support for arbitrarity nested future proofs -- replaced crude order by explicit normalization (which might loop for bad dependencies);
wenzelm
parents:
32035
diff
changeset
|
703 |
fun make_deriv promises oracles thms proof = |
7991cdf10a54
support for arbitrarity nested future proofs -- replaced crude order by explicit normalization (which might loop for bad dependencies);
wenzelm
parents:
32035
diff
changeset
|
704 |
Deriv {promises = promises, body = PBody {oracles = oracles, thms = thms, proof = proof}}; |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
705 |
|
70398 | 706 |
val empty_deriv = make_deriv [] [] [] MinProof; |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
707 |
|
28330 | 708 |
|
28354 | 709 |
(* inference rules *) |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
710 |
|
28378
60cc0359363d
promise: include check into future body, i.e. joined results are always valid;
wenzelm
parents:
28364
diff
changeset
|
711 |
fun promise_ord ((i, _), (j, _)) = int_ord (j, i); |
28330 | 712 |
|
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
713 |
fun deriv_rule2 f |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
714 |
(Deriv {promises = ps1, body = PBody {oracles = oracles1, thms = thms1, proof = prf1}}) |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
715 |
(Deriv {promises = ps2, body = PBody {oracles = oracles2, thms = thms2, proof = prf2}}) = |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
716 |
let |
39687 | 717 |
val ps = Ord_List.union promise_ord ps1 ps2; |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
718 |
val oracles = Proofterm.unions_oracles [oracles1, oracles2]; |
44334 | 719 |
val thms = Proofterm.unions_thms [thms1, thms2]; |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
720 |
val prf = |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
721 |
(case ! Proofterm.proofs of |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
722 |
2 => f prf1 prf2 |
28804
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
723 |
| 1 => MinProof |
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
724 |
| 0 => MinProof |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
725 |
| i => error ("Illegal level of detail for proof objects: " ^ string_of_int i)); |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
726 |
in make_deriv ps oracles thms prf end; |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
727 |
|
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
728 |
fun deriv_rule1 f = deriv_rule2 (K f) empty_deriv; |
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
729 |
fun deriv_rule0 prf = deriv_rule1 I (make_deriv [] [] [] prf); |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
730 |
|
36621
2fd4e2c76636
proof terms for strip_shyps, based on the version by krauss/schropp with some notable differences:
wenzelm
parents:
36619
diff
changeset
|
731 |
fun deriv_rule_unconditional f (Deriv {promises, body = PBody {oracles, thms, proof}}) = |
2fd4e2c76636
proof terms for strip_shyps, based on the version by krauss/schropp with some notable differences:
wenzelm
parents:
36619
diff
changeset
|
732 |
make_deriv promises oracles thms (f proof); |
2fd4e2c76636
proof terms for strip_shyps, based on the version by krauss/schropp with some notable differences:
wenzelm
parents:
36619
diff
changeset
|
733 |
|
1238 | 734 |
|
32725 | 735 |
(* fulfilled proofs *) |
736 |
||
44331 | 737 |
fun raw_body_of (Thm (Deriv {body, ...}, _)) = body; |
738 |
fun raw_promises_of (Thm (Deriv {promises, ...}, _)) = promises; |
|
739 |
||
740 |
fun join_promises [] = () |
|
741 |
| join_promises promises = join_promises_of (Future.joins (map snd promises)) |
|
49008
a3cdb49c22cc
proper merge of promises to avoid exponential blow-up in pathologic situations (e.g. lack of PThm wrapping);
wenzelm
parents:
48263
diff
changeset
|
742 |
and join_promises_of thms = join_promises (Ord_List.make promise_ord (maps raw_promises_of thms)); |
32725 | 743 |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
744 |
fun fulfill_body (th as Thm (Deriv {promises, body}, _)) = |
64571 | 745 |
let val fulfilled_promises = map #1 promises ~~ map fulfill_body (Future.joins (map #2 promises)) |
746 |
in Proofterm.fulfill_norm_proof (theory_of_thm th) fulfilled_promises body end; |
|
32725 | 747 |
|
64574
1134e4d5e5b7
consolidate nested thms with persistent result, for improved performance;
wenzelm
parents:
64573
diff
changeset
|
748 |
fun proof_bodies_of thms = (join_promises_of thms; map fulfill_body thms); |
44333
cc53ce50f738
reverted to join_bodies/join_proofs based on fold_body_thms to regain performance (escpecially of HOL-Proofs) -- see also aa9c1e9ef2ce and 4e2abb045eac;
wenzelm
parents:
44331
diff
changeset
|
749 |
val proof_body_of = singleton proof_bodies_of; |
44331 | 750 |
val proof_of = Proofterm.proof_of o proof_body_of; |
32725 | 751 |
|
66168 | 752 |
val consolidate = ignore o proof_bodies_of; |
32725 | 753 |
|
754 |
||
755 |
(* derivation status *) |
|
756 |
||
50126
3dec88149176
theorem status about oracles/futures is no longer printed by default;
wenzelm
parents:
49008
diff
changeset
|
757 |
fun peek_status (Thm (Deriv {promises, body}, _)) = |
32725 | 758 |
let |
759 |
val ps = map (Future.peek o snd) promises; |
|
760 |
val bodies = body :: |
|
44331 | 761 |
map_filter (fn SOME (Exn.Res th) => SOME (raw_body_of th) | _ => NONE) ps; |
50126
3dec88149176
theorem status about oracles/futures is no longer printed by default;
wenzelm
parents:
49008
diff
changeset
|
762 |
val {oracle, unfinished, failed} = Proofterm.peek_status bodies; |
32725 | 763 |
in |
764 |
{oracle = oracle, |
|
765 |
unfinished = unfinished orelse exists is_none ps, |
|
766 |
failed = failed orelse exists (fn SOME (Exn.Exn _) => true | _ => false) ps} |
|
767 |
end; |
|
768 |
||
769 |
||
770 |
(* future rule *) |
|
771 |
||
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
772 |
fun future_result i orig_cert orig_shyps orig_prop thm = |
32725 | 773 |
let |
36613
f3157c288aca
simplified primitive Thm.future: more direct theory check, do not hardwire strip_shyps here;
wenzelm
parents:
36330
diff
changeset
|
774 |
fun err msg = raise THM ("future_result: " ^ msg, 0, [thm]); |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
775 |
val Thm (Deriv {promises, ...}, {cert, constraints, shyps, hyps, tpairs, prop, ...}) = thm; |
36613
f3157c288aca
simplified primitive Thm.future: more direct theory check, do not hardwire strip_shyps here;
wenzelm
parents:
36330
diff
changeset
|
776 |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
777 |
val _ = Context.eq_certificate (cert, orig_cert) orelse err "bad theory"; |
32725 | 778 |
val _ = prop aconv orig_prop orelse err "bad prop"; |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
779 |
val _ = null constraints orelse err "bad sort constraints"; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
780 |
val _ = null tpairs orelse err "bad flex-flex constraints"; |
32725 | 781 |
val _ = null hyps orelse err "bad hyps"; |
782 |
val _ = Sorts.subset (shyps, orig_shyps) orelse err "bad shyps"; |
|
783 |
val _ = forall (fn (j, _) => i <> j) promises orelse err "bad dependencies"; |
|
44331 | 784 |
val _ = join_promises promises; |
32725 | 785 |
in thm end; |
786 |
||
787 |
fun future future_thm ct = |
|
788 |
let |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
789 |
val Cterm {cert = cert, t = prop, T, maxidx, sorts} = ct; |
32725 | 790 |
val _ = T <> propT andalso raise CTERM ("future: prop expected", [ct]); |
70398 | 791 |
val _ = |
792 |
if Proofterm.proofs_enabled () |
|
793 |
then raise CTERM ("future: proof terms enabled", [ct]) else (); |
|
32725 | 794 |
|
795 |
val i = serial (); |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
796 |
val future = future_thm |> Future.map (future_result i cert sorts prop); |
32725 | 797 |
in |
70398 | 798 |
Thm (make_deriv [(i, future)] [] [] MinProof, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
799 |
{cert = cert, |
32725 | 800 |
tags = [], |
801 |
maxidx = maxidx, |
|
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
802 |
constraints = [], |
32725 | 803 |
shyps = sorts, |
804 |
hyps = [], |
|
805 |
tpairs = [], |
|
806 |
prop = prop}) |
|
807 |
end; |
|
808 |
||
809 |
||
1238 | 810 |
|
1529 | 811 |
(** Axioms **) |
387
69f4356d915d
new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents:
309
diff
changeset
|
812 |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
813 |
fun axiom thy0 name = |
387
69f4356d915d
new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents:
309
diff
changeset
|
814 |
let |
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
815 |
fun get_ax thy = |
59884 | 816 |
Name_Space.lookup (Theory.axiom_table thy) name |
817 |
|> Option.map (fn prop => |
|
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
818 |
let |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
819 |
val der = deriv_rule0 (Proofterm.axm_proof name prop); |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
820 |
val cert = Context.Certificate thy; |
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
821 |
val maxidx = maxidx_of_term prop; |
26640
92e6d3ec91bd
simplified handling of sorts, removed unnecessary universal witness;
wenzelm
parents:
26631
diff
changeset
|
822 |
val shyps = Sorts.insert_term prop []; |
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
823 |
in |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
824 |
Thm (der, |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
825 |
{cert = cert, tags = [], maxidx = maxidx, |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
826 |
constraints = [], shyps = shyps, hyps = [], tpairs = [], prop = prop}) |
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
827 |
end); |
387
69f4356d915d
new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents:
309
diff
changeset
|
828 |
in |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
829 |
(case get_first get_ax (Theory.nodes_of thy0) of |
15531 | 830 |
SOME thm => thm |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
831 |
| NONE => raise THEORY ("No axiom " ^ quote name, [thy0])) |
387
69f4356d915d
new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents:
309
diff
changeset
|
832 |
end; |
69f4356d915d
new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents:
309
diff
changeset
|
833 |
|
776
df8f91c0e57c
improved axioms_of: returns thms as the manual says;
wenzelm
parents:
721
diff
changeset
|
834 |
(*return additional axioms of this theory node*) |
df8f91c0e57c
improved axioms_of: returns thms as the manual says;
wenzelm
parents:
721
diff
changeset
|
835 |
fun axioms_of thy = |
56025 | 836 |
map (fn (name, _) => (name, axiom thy name)) (Theory.axioms_of thy); |
776
df8f91c0e57c
improved axioms_of: returns thms as the manual says;
wenzelm
parents:
721
diff
changeset
|
837 |
|
6089 | 838 |
|
28804
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
839 |
(* tags *) |
6089 | 840 |
|
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
841 |
val get_tags = #tags o rep_thm; |
6089 | 842 |
|
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
843 |
fun map_tags f (Thm (der, {cert, tags, maxidx, constraints, shyps, hyps, tpairs, prop})) = |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
844 |
Thm (der, {cert = cert, tags = f tags, maxidx = maxidx, constraints = constraints, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
845 |
shyps = shyps, hyps = hyps, tpairs = tpairs, prop = prop}); |
0 | 846 |
|
847 |
||
43795
ca5896a836ba
recovered some runtime sharing from d6b6c74a8bcf, without the global memory bottleneck;
wenzelm
parents:
43761
diff
changeset
|
848 |
(* technical adjustments *) |
ca5896a836ba
recovered some runtime sharing from d6b6c74a8bcf, without the global memory bottleneck;
wenzelm
parents:
43761
diff
changeset
|
849 |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
850 |
fun norm_proof (th as Thm (der, args)) = |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
851 |
Thm (deriv_rule1 (Proofterm.rew_proof (theory_of_thm th)) der, args); |
23781
ab793a6ddf9f
Added function norm_proof for normalizing the proof term
berghofe
parents:
23657
diff
changeset
|
852 |
|
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
853 |
fun adjust_maxidx_thm i |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
854 |
(th as Thm (der, {cert, tags, maxidx, constraints, shyps, hyps, tpairs, prop})) = |
20261 | 855 |
if maxidx = i then th |
856 |
else if maxidx < i then |
|
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
857 |
Thm (der, {maxidx = i, cert = cert, tags = tags, constraints = constraints, shyps = shyps, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
858 |
hyps = hyps, tpairs = tpairs, prop = prop}) |
20261 | 859 |
else |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
860 |
Thm (der, {maxidx = Int.max (maxidx_tpairs tpairs (maxidx_of_term prop), i), |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
861 |
cert = cert, tags = tags, constraints = constraints, shyps = shyps, |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
862 |
hyps = hyps, tpairs = tpairs, prop = prop}); |
564 | 863 |
|
387
69f4356d915d
new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents:
309
diff
changeset
|
864 |
|
2509 | 865 |
|
70454 | 866 |
(*** Theory data ***) |
867 |
||
70458 | 868 |
(* type classes *) |
869 |
||
70465 | 870 |
structure Aritytab = |
871 |
Table( |
|
872 |
type key = string * sort list * class; |
|
873 |
val ord = |
|
874 |
fast_string_ord o apply2 #1 |
|
875 |
<<< fast_string_ord o apply2 #3 |
|
876 |
<<< list_ord Term_Ord.sort_ord o apply2 #2; |
|
877 |
); |
|
878 |
||
70458 | 879 |
datatype classes = Classes of |
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
880 |
{classrels: thm Symreltab.table, |
70475
98b6da301e13
backed out changeset 1b8858f4c393: odd problems e.g. in CAVA_LTL_Modelchecker;
wenzelm
parents:
70472
diff
changeset
|
881 |
arities: (thm * string * serial) Aritytab.table}; |
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
882 |
|
70458 | 883 |
fun make_classes (classrels, arities) = Classes {classrels = classrels, arities = arities}; |
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
884 |
|
70465 | 885 |
val empty_classes = make_classes (Symreltab.empty, Aritytab.empty); |
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
886 |
|
70458 | 887 |
(*see Theory.at_begin hook for transitive closure of classrels and arity completion*) |
888 |
fun merge_classes |
|
889 |
(Classes {classrels = classrels1, arities = arities1}, |
|
890 |
Classes {classrels = classrels2, arities = arities2}) = |
|
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
891 |
let |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
892 |
val classrels' = Symreltab.merge (K true) (classrels1, classrels2); |
70465 | 893 |
val arities' = Aritytab.merge (K true) (arities1, arities2); |
70458 | 894 |
in make_classes (classrels', arities') end; |
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
895 |
|
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
896 |
|
70458 | 897 |
(* data *) |
898 |
||
70454 | 899 |
structure Data = Theory_Data |
900 |
( |
|
901 |
type T = |
|
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
902 |
unit Name_Space.table * (*oracles: authentic derivation names*) |
70458 | 903 |
classes; (*type classes within the logic*) |
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
904 |
|
70458 | 905 |
val empty : T = (Name_Space.empty_table "oracle", empty_classes); |
70454 | 906 |
val extend = I; |
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
907 |
fun merge ((oracles1, sorts1), (oracles2, sorts2)) : T = |
70458 | 908 |
(Name_Space.merge_tables (oracles1, oracles2), merge_classes (sorts1, sorts2)); |
70454 | 909 |
); |
910 |
||
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
911 |
val get_oracles = #1 o Data.get; |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
912 |
val map_oracles = Data.map o apfst; |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
913 |
|
70458 | 914 |
val get_classes = (fn (_, Classes args) => args) o Data.get; |
915 |
val get_classrels = #classrels o get_classes; |
|
916 |
val get_arities = #arities o get_classes; |
|
917 |
||
918 |
fun map_classes f = |
|
919 |
(Data.map o apsnd) (fn Classes {classrels, arities} => make_classes (f (classrels, arities))); |
|
920 |
fun map_classrels f = map_classes (fn (classrels, arities) => (f classrels, arities)); |
|
921 |
fun map_arities f = map_classes (fn (classrels, arities) => (classrels, f arities)); |
|
922 |
||
923 |
||
924 |
(* type classes *) |
|
925 |
||
926 |
fun the_classrel thy (c1, c2) = |
|
927 |
(case Symreltab.lookup (get_classrels thy) (c1, c2) of |
|
928 |
SOME thm => transfer thy thm |
|
929 |
| NONE => error ("Unproven class relation " ^ |
|
930 |
Syntax.string_of_classrel (Proof_Context.init_global thy) [c1, c2])); |
|
931 |
||
932 |
fun the_arity thy (a, Ss, c) = |
|
70465 | 933 |
(case Aritytab.lookup (get_arities thy) (a, Ss, c) of |
70475
98b6da301e13
backed out changeset 1b8858f4c393: odd problems e.g. in CAVA_LTL_Modelchecker;
wenzelm
parents:
70472
diff
changeset
|
934 |
SOME (thm, _, _) => transfer thy thm |
70458 | 935 |
| NONE => error ("Unproven type arity " ^ |
936 |
Syntax.string_of_arity (Proof_Context.init_global thy) (a, Ss, [c]))); |
|
937 |
||
938 |
val classrel_proof = proof_of oo the_classrel; |
|
939 |
val arity_proof = proof_of oo the_arity; |
|
70457 | 940 |
|
70458 | 941 |
|
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
942 |
(* solve sort constraints by pro-forma proof *) |
70458 | 943 |
|
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
944 |
local |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
945 |
|
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
946 |
fun union_digest (oracles1, thms1) (oracles2, thms2) = |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
947 |
(Proofterm.unions_oracles [oracles1, oracles2], Proofterm.unions_thms [thms1, thms2]); |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
948 |
|
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
949 |
fun thm_digest (Thm (Deriv {body = Proofterm.PBody {oracles, thms, ...}, ...}, _)) = |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
950 |
(oracles, thms); |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
951 |
|
70480
1a1b7d7f24bb
explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents:
70475
diff
changeset
|
952 |
fun constraint_digest ({theory = thy, typ, sort, ...}: constraint) = |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
953 |
Sorts.of_sort_derivation (Sign.classes_of thy) |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
954 |
{class_relation = fn _ => fn _ => fn (digest, c1) => fn c2 => |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
955 |
if c1 = c2 then ([], []) else union_digest digest (thm_digest (the_classrel thy (c1, c2))), |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
956 |
type_constructor = fn (a, _) => fn dom => fn c => |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
957 |
let val arity_digest = thm_digest (the_arity thy (a, (map o map) #2 dom, c)) |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
958 |
in (fold o fold) (union_digest o #1) dom arity_digest end, |
70480
1a1b7d7f24bb
explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents:
70475
diff
changeset
|
959 |
type_variable = fn T => map (pair ([], [])) (Type.sort_of_atyp T)} |
1a1b7d7f24bb
explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents:
70475
diff
changeset
|
960 |
(typ, sort); |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
961 |
|
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
962 |
in |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
963 |
|
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
964 |
fun solve_constraints (thm as Thm (_, {constraints = [], ...})) = thm |
70480
1a1b7d7f24bb
explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents:
70475
diff
changeset
|
965 |
| solve_constraints (thm as Thm (der, args)) = |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
966 |
let |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
967 |
val {cert, tags, maxidx, constraints, shyps, hyps, tpairs, prop} = args; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
968 |
|
70480
1a1b7d7f24bb
explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents:
70475
diff
changeset
|
969 |
val thy = Context.certificate_theory cert; |
1a1b7d7f24bb
explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents:
70475
diff
changeset
|
970 |
val bad_thys = |
1a1b7d7f24bb
explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents:
70475
diff
changeset
|
971 |
constraints |> map_filter (fn {theory = thy', ...} => |
1a1b7d7f24bb
explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents:
70475
diff
changeset
|
972 |
if Context.eq_thy (thy, thy') then NONE else SOME thy'); |
1a1b7d7f24bb
explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents:
70475
diff
changeset
|
973 |
val () = |
1a1b7d7f24bb
explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents:
70475
diff
changeset
|
974 |
if null bad_thys then () |
1a1b7d7f24bb
explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents:
70475
diff
changeset
|
975 |
else |
1a1b7d7f24bb
explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents:
70475
diff
changeset
|
976 |
raise THEORY ("solve_constraints: bad theories for theorem\n" ^ |
1a1b7d7f24bb
explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents:
70475
diff
changeset
|
977 |
Syntax.string_of_term_global thy (prop_of thm), thy :: bad_thys); |
1a1b7d7f24bb
explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents:
70475
diff
changeset
|
978 |
|
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
979 |
val Deriv {promises, body = Proofterm.PBody {oracles, thms, proof}} = der; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
980 |
val (oracles', thms') = (oracles, thms) |
70480
1a1b7d7f24bb
explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents:
70475
diff
changeset
|
981 |
|> fold (fold union_digest o constraint_digest) constraints; |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
982 |
val body' = Proofterm.PBody {oracles = oracles', thms = thms', proof = proof}; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
983 |
in |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
984 |
Thm (Deriv {promises = promises, body = body'}, |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
985 |
{constraints = [], cert = cert, tags = tags, maxidx = maxidx, |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
986 |
shyps = shyps, hyps = hyps, tpairs = tpairs, prop = prop}) |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
987 |
end; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
988 |
|
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
989 |
end; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
990 |
|
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
991 |
|
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
992 |
|
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
993 |
(*** Closed theorems with official name ***) |
70458 | 994 |
|
995 |
(*non-deterministic, depends on unknown promises*) |
|
996 |
fun derivation_closed (Thm (Deriv {body, ...}, _)) = |
|
997 |
Proofterm.compact_proof (Proofterm.proof_of body); |
|
998 |
||
999 |
(*non-deterministic, depends on unknown promises*) |
|
1000 |
fun derivation_name (Thm (Deriv {body, ...}, {shyps, hyps, prop, ...})) = |
|
1001 |
Proofterm.get_name shyps hyps prop (Proofterm.proof_of body); |
|
1002 |
||
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1003 |
fun name_derivation name = |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1004 |
solve_constraints #> (fn thm as Thm (der, args) => |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1005 |
let |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1006 |
val thy = theory_of_thm thm; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1007 |
|
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1008 |
val Deriv {promises, body} = der; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1009 |
val {shyps, hyps, prop, tpairs, ...} = args; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1010 |
|
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1011 |
fun err msg = raise THM ("name_derivation: " ^ msg, 0, [thm]); |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1012 |
val _ = null tpairs orelse err "bad flex-flex constraints"; |
70458 | 1013 |
|
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1014 |
val ps = map (apsnd (Future.map fulfill_body)) promises; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1015 |
val (pthm, proof) = |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1016 |
Proofterm.thm_proof thy (classrel_proof thy) (arity_proof thy) name shyps hyps prop ps body; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1017 |
val der' = make_deriv [] [] [pthm] proof; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1018 |
in Thm (der', args) end); |
70458 | 1019 |
|
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1020 |
val close_derivation = |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1021 |
solve_constraints #> (fn thm => |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1022 |
if derivation_closed thm then thm else name_derivation "" thm); |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1023 |
|
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1024 |
val trim_context = solve_constraints #> trim_context_thm; |
70454 | 1025 |
|
1026 |
||
1027 |
||
1028 |
(*** Oracles ***) |
|
1029 |
||
1030 |
fun add_oracle (b, oracle_fn) thy = |
|
1031 |
let |
|
1032 |
val (name, oracles') = Name_Space.define (Context.Theory thy) true (b, ()) (get_oracles thy); |
|
1033 |
val thy' = map_oracles (K oracles') thy; |
|
1034 |
fun invoke_oracle arg = |
|
1035 |
let val Cterm {cert = cert2, t = prop, T, maxidx, sorts} = oracle_fn arg in |
|
1036 |
if T <> propT then |
|
1037 |
raise THM ("Oracle's result must have type prop: " ^ name, 0, []) |
|
1038 |
else |
|
1039 |
let val (oracle, prf) = Proofterm.oracle_proof name prop in |
|
1040 |
Thm (make_deriv [] [oracle] [] prf, |
|
1041 |
{cert = Context.join_certificate (Context.Certificate thy', cert2), |
|
1042 |
tags = [], |
|
1043 |
maxidx = maxidx, |
|
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1044 |
constraints = [], |
70454 | 1045 |
shyps = sorts, |
1046 |
hyps = [], |
|
1047 |
tpairs = [], |
|
1048 |
prop = prop}) |
|
1049 |
end |
|
1050 |
end; |
|
1051 |
in ((name, invoke_oracle), thy') end; |
|
1052 |
||
1053 |
fun extern_oracles verbose ctxt = |
|
1054 |
map #1 (Name_Space.markup_table verbose ctxt (get_oracles (Proof_Context.theory_of ctxt))); |
|
1055 |
||
1056 |
||
1057 |
||
1529 | 1058 |
(*** Meta rules ***) |
0 | 1059 |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1060 |
(** primitive rules **) |
0 | 1061 |
|
16656 | 1062 |
(*The assumption rule A |- A*) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1063 |
fun assume raw_ct = |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1064 |
let val Cterm {cert, t = prop, T, maxidx, sorts} = adjust_maxidx_cterm ~1 raw_ct in |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1065 |
if T <> propT then |
19230 | 1066 |
raise THM ("assume: prop", 0, []) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1067 |
else if maxidx <> ~1 then |
19230 | 1068 |
raise THM ("assume: variables", maxidx, []) |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1069 |
else Thm (deriv_rule0 (Proofterm.Hyp prop), |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1070 |
{cert = cert, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1071 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1072 |
maxidx = ~1, |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1073 |
constraints = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1074 |
shyps = sorts, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1075 |
hyps = [prop], |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1076 |
tpairs = [], |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1077 |
prop = prop}) |
0 | 1078 |
end; |
1079 |
||
1220 | 1080 |
(*Implication introduction |
3529 | 1081 |
[A] |
1082 |
: |
|
1083 |
B |
|
1220 | 1084 |
------- |
67721 | 1085 |
A \<Longrightarrow> B |
1220 | 1086 |
*) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1087 |
fun implies_intr |
68691 | 1088 |
(ct as Cterm {t = A, T, maxidx = maxidx1, sorts, ...}) |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1089 |
(th as Thm (der, {maxidx = maxidx2, hyps, constraints, shyps, tpairs, prop, ...})) = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1090 |
if T <> propT then |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1091 |
raise THM ("implies_intr: assumptions must have type prop", 0, [th]) |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1092 |
else |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1093 |
Thm (deriv_rule1 (Proofterm.implies_intr_proof A) der, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1094 |
{cert = join_certificate1 (ct, th), |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1095 |
tags = [], |
68691 | 1096 |
maxidx = Int.max (maxidx1, maxidx2), |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1097 |
constraints = constraints, |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1098 |
shyps = Sorts.union sorts shyps, |
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1099 |
hyps = remove_hyps A hyps, |
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1100 |
tpairs = tpairs, |
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1101 |
prop = Logic.mk_implies (A, prop)}); |
0 | 1102 |
|
1529 | 1103 |
|
1220 | 1104 |
(*Implication elimination |
67721 | 1105 |
A \<Longrightarrow> B A |
1220 | 1106 |
------------ |
1107 |
B |
|
1108 |
*) |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1109 |
fun implies_elim thAB thA = |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1110 |
let |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1111 |
val Thm (derA, |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1112 |
{maxidx = maxidx1, hyps = hypsA, constraints = constraintsA, shyps = shypsA, |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1113 |
tpairs = tpairsA, prop = propA, ...}) = thA |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1114 |
and Thm (der, {maxidx = maxidx2, hyps, constraints, shyps, tpairs, prop, ...}) = thAB; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1115 |
fun err () = raise THM ("implies_elim: major premise", 0, [thAB, thA]); |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1116 |
in |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1117 |
(case prop of |
56245 | 1118 |
Const ("Pure.imp", _) $ A $ B => |
20512 | 1119 |
if A aconv propA then |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1120 |
Thm (deriv_rule2 (curry Proofterm.%%) der derA, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1121 |
{cert = join_certificate2 (thAB, thA), |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1122 |
tags = [], |
68691 | 1123 |
maxidx = Int.max (maxidx1, maxidx2), |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1124 |
constraints = union_constraints constraintsA constraints, |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1125 |
shyps = Sorts.union shypsA shyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1126 |
hyps = union_hyps hypsA hyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1127 |
tpairs = union_tpairs tpairsA tpairs, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1128 |
prop = B}) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1129 |
else err () |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1130 |
| _ => err ()) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1131 |
end; |
250 | 1132 |
|
1220 | 1133 |
(*Forall introduction. The Free or Var x must not be free in the hypotheses. |
16656 | 1134 |
[x] |
1135 |
: |
|
1136 |
A |
|
1137 |
------ |
|
67721 | 1138 |
\<And>x. A |
1220 | 1139 |
*) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1140 |
fun forall_intr |
68692
0c568ec56f37
proper maxidx: if x does not occur in A, its maxidx could get lost;
wenzelm
parents:
68691
diff
changeset
|
1141 |
(ct as Cterm {maxidx = maxidx1, t = x, T, sorts, ...}) |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1142 |
(th as Thm (der, {maxidx = maxidx2, constraints, shyps, hyps, tpairs, prop, ...})) = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1143 |
let |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1144 |
fun result a = |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1145 |
Thm (deriv_rule1 (Proofterm.forall_intr_proof x a) der, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1146 |
{cert = join_certificate1 (ct, th), |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1147 |
tags = [], |
68692
0c568ec56f37
proper maxidx: if x does not occur in A, its maxidx could get lost;
wenzelm
parents:
68691
diff
changeset
|
1148 |
maxidx = Int.max (maxidx1, maxidx2), |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1149 |
constraints = constraints, |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1150 |
shyps = Sorts.union sorts shyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1151 |
hyps = hyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1152 |
tpairs = tpairs, |
46217
7b19666f0e3d
renamed Term.all to Logic.all_const, in accordance to HOLogic.all_const;
wenzelm
parents:
45443
diff
changeset
|
1153 |
prop = Logic.all_const T $ Abs (a, T, abstract_over (x, prop))}); |
21798 | 1154 |
fun check_occs a x ts = |
16847
8fc160b12e73
invoke_oracle: do not keep theory value, but theory_ref;
wenzelm
parents:
16725
diff
changeset
|
1155 |
if exists (fn t => Logic.occs (x, t)) ts then |
21798 | 1156 |
raise THM ("forall_intr: variable " ^ quote a ^ " free in assumptions", 0, [th]) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1157 |
else (); |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1158 |
in |
52788 | 1159 |
(case x of |
21798 | 1160 |
Free (a, _) => (check_occs a x hyps; check_occs a x (terms_of_tpairs tpairs); result a) |
1161 |
| Var ((a, _), _) => (check_occs a x (terms_of_tpairs tpairs); result a) |
|
52788 | 1162 |
| _ => raise THM ("forall_intr: not a variable", 0, [th])) |
0 | 1163 |
end; |
1164 |
||
1220 | 1165 |
(*Forall elimination |
67721 | 1166 |
\<And>x. A |
1220 | 1167 |
------ |
1168 |
A[t/x] |
|
1169 |
*) |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1170 |
fun forall_elim |
68691 | 1171 |
(ct as Cterm {t, T, maxidx = maxidx1, sorts, ...}) |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1172 |
(th as Thm (der, {maxidx = maxidx2, constraints, shyps, hyps, tpairs, prop, ...})) = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1173 |
(case prop of |
56245 | 1174 |
Const ("Pure.all", Type ("fun", [Type ("fun", [qary, _]), _])) $ A => |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1175 |
if T <> qary then |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1176 |
raise THM ("forall_elim: type mismatch", 0, [th]) |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1177 |
else |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1178 |
Thm (deriv_rule1 (Proofterm.% o rpair (SOME t)) der, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1179 |
{cert = join_certificate1 (ct, th), |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1180 |
tags = [], |
68691 | 1181 |
maxidx = Int.max (maxidx1, maxidx2), |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1182 |
constraints = constraints, |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1183 |
shyps = Sorts.union sorts shyps, |
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1184 |
hyps = hyps, |
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1185 |
tpairs = tpairs, |
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1186 |
prop = Term.betapply (A, t)}) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1187 |
| _ => raise THM ("forall_elim: not quantified", 0, [th])); |
0 | 1188 |
|
1189 |
||
1220 | 1190 |
(* Equality *) |
0 | 1191 |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1192 |
(*Reflexivity |
67721 | 1193 |
t \<equiv> t |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1194 |
*) |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1195 |
fun reflexive (Cterm {cert, t, T = _, maxidx, sorts}) = |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1196 |
Thm (deriv_rule0 Proofterm.reflexive, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1197 |
{cert = cert, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1198 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1199 |
maxidx = maxidx, |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1200 |
constraints = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1201 |
shyps = sorts, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1202 |
hyps = [], |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1203 |
tpairs = [], |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1204 |
prop = Logic.mk_equals (t, t)}); |
0 | 1205 |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1206 |
(*Symmetry |
67721 | 1207 |
t \<equiv> u |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1208 |
------ |
67721 | 1209 |
u \<equiv> t |
1220 | 1210 |
*) |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1211 |
fun symmetric (th as Thm (der, {cert, maxidx, constraints, shyps, hyps, tpairs, prop, ...})) = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1212 |
(case prop of |
56245 | 1213 |
(eq as Const ("Pure.eq", _)) $ t $ u => |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1214 |
Thm (deriv_rule1 Proofterm.symmetric der, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1215 |
{cert = cert, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1216 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1217 |
maxidx = maxidx, |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1218 |
constraints = constraints, |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1219 |
shyps = shyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1220 |
hyps = hyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1221 |
tpairs = tpairs, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1222 |
prop = eq $ u $ t}) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1223 |
| _ => raise THM ("symmetric", 0, [th])); |
0 | 1224 |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1225 |
(*Transitivity |
67721 | 1226 |
t1 \<equiv> u u \<equiv> t2 |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1227 |
------------------ |
67721 | 1228 |
t1 \<equiv> t2 |
1220 | 1229 |
*) |
0 | 1230 |
fun transitive th1 th2 = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1231 |
let |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1232 |
val Thm (der1, {maxidx = maxidx1, hyps = hyps1, constraints = constraints1, shyps = shyps1, |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1233 |
tpairs = tpairs1, prop = prop1, ...}) = th1 |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1234 |
and Thm (der2, {maxidx = maxidx2, hyps = hyps2, constraints = constraints2, shyps = shyps2, |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1235 |
tpairs = tpairs2, prop = prop2, ...}) = th2; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1236 |
fun err msg = raise THM ("transitive: " ^ msg, 0, [th1, th2]); |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1237 |
in |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1238 |
case (prop1, prop2) of |
56245 | 1239 |
((eq as Const ("Pure.eq", Type (_, [T, _]))) $ t1 $ u, Const ("Pure.eq", _) $ u' $ t2) => |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1240 |
if not (u aconv u') then err "middle term" |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1241 |
else |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1242 |
Thm (deriv_rule2 (Proofterm.transitive u T) der1 der2, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1243 |
{cert = join_certificate2 (th1, th2), |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1244 |
tags = [], |
68691 | 1245 |
maxidx = Int.max (maxidx1, maxidx2), |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1246 |
constraints = union_constraints constraints1 constraints2, |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1247 |
shyps = Sorts.union shyps1 shyps2, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1248 |
hyps = union_hyps hyps1 hyps2, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1249 |
tpairs = union_tpairs tpairs1 tpairs2, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1250 |
prop = eq $ t1 $ t2}) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1251 |
| _ => err "premises" |
0 | 1252 |
end; |
1253 |
||
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1254 |
(*Beta-conversion |
67721 | 1255 |
(\<lambda>x. t) u \<equiv> t[u/x] |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1256 |
fully beta-reduces the term if full = true |
10416
5b33e732e459
- Moved rewriting functions to meta_simplifier.ML
berghofe
parents:
10348
diff
changeset
|
1257 |
*) |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1258 |
fun beta_conversion full (Cterm {cert, t, T = _, maxidx, sorts}) = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1259 |
let val t' = |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1260 |
if full then Envir.beta_norm t |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1261 |
else |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1262 |
(case t of Abs (_, _, bodt) $ u => subst_bound (u, bodt) |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1263 |
| _ => raise THM ("beta_conversion: not a redex", 0, [])); |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1264 |
in |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1265 |
Thm (deriv_rule0 Proofterm.reflexive, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1266 |
{cert = cert, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1267 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1268 |
maxidx = maxidx, |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1269 |
constraints = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1270 |
shyps = sorts, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1271 |
hyps = [], |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1272 |
tpairs = [], |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1273 |
prop = Logic.mk_equals (t, t')}) |
10416
5b33e732e459
- Moved rewriting functions to meta_simplifier.ML
berghofe
parents:
10348
diff
changeset
|
1274 |
end; |
5b33e732e459
- Moved rewriting functions to meta_simplifier.ML
berghofe
parents:
10348
diff
changeset
|
1275 |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1276 |
fun eta_conversion (Cterm {cert, t, T = _, maxidx, sorts}) = |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1277 |
Thm (deriv_rule0 Proofterm.reflexive, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1278 |
{cert = cert, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1279 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1280 |
maxidx = maxidx, |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1281 |
constraints = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1282 |
shyps = sorts, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1283 |
hyps = [], |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1284 |
tpairs = [], |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1285 |
prop = Logic.mk_equals (t, Envir.eta_contract t)}); |
0 | 1286 |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1287 |
fun eta_long_conversion (Cterm {cert, t, T = _, maxidx, sorts}) = |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1288 |
Thm (deriv_rule0 Proofterm.reflexive, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1289 |
{cert = cert, |
23493 | 1290 |
tags = [], |
1291 |
maxidx = maxidx, |
|
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1292 |
constraints = [], |
23493 | 1293 |
shyps = sorts, |
1294 |
hyps = [], |
|
1295 |
tpairs = [], |
|
52131 | 1296 |
prop = Logic.mk_equals (t, Envir.eta_long [] t)}); |
23493 | 1297 |
|
0 | 1298 |
(*The abstraction rule. The Free or Var x must not be free in the hypotheses. |
1299 |
The bound variable will be named "a" (since x will be something like x320) |
|
67721 | 1300 |
t \<equiv> u |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1301 |
-------------- |
67721 | 1302 |
\<lambda>x. t \<equiv> \<lambda>x. u |
1220 | 1303 |
*) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1304 |
fun abstract_rule a |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1305 |
(Cterm {t = x, T, sorts, ...}) |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1306 |
(th as Thm (der, {cert, maxidx, hyps, constraints, shyps, tpairs, prop, ...})) = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1307 |
let |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1308 |
val (t, u) = Logic.dest_equals prop |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1309 |
handle TERM _ => raise THM ("abstract_rule: premise not an equality", 0, [th]); |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1310 |
val result = |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1311 |
Thm (deriv_rule1 (Proofterm.abstract_rule x a) der, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1312 |
{cert = cert, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1313 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1314 |
maxidx = maxidx, |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1315 |
constraints = constraints, |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1316 |
shyps = Sorts.union sorts shyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1317 |
hyps = hyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1318 |
tpairs = tpairs, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1319 |
prop = Logic.mk_equals |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1320 |
(Abs (a, T, abstract_over (x, t)), Abs (a, T, abstract_over (x, u)))}); |
21798 | 1321 |
fun check_occs a x ts = |
16847
8fc160b12e73
invoke_oracle: do not keep theory value, but theory_ref;
wenzelm
parents:
16725
diff
changeset
|
1322 |
if exists (fn t => Logic.occs (x, t)) ts then |
21798 | 1323 |
raise THM ("abstract_rule: variable " ^ quote a ^ " free in assumptions", 0, [th]) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1324 |
else (); |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1325 |
in |
52788 | 1326 |
(case x of |
21798 | 1327 |
Free (a, _) => (check_occs a x hyps; check_occs a x (terms_of_tpairs tpairs); result) |
1328 |
| Var ((a, _), _) => (check_occs a x (terms_of_tpairs tpairs); result) |
|
52788 | 1329 |
| _ => raise THM ("abstract_rule: not a variable", 0, [th])) |
0 | 1330 |
end; |
1331 |
||
1332 |
(*The combination rule |
|
67721 | 1333 |
f \<equiv> g t \<equiv> u |
1334 |
------------- |
|
1335 |
f t \<equiv> g u |
|
1220 | 1336 |
*) |
0 | 1337 |
fun combination th1 th2 = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1338 |
let |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1339 |
val Thm (der1, {maxidx = maxidx1, constraints = constraints1, shyps = shyps1, |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1340 |
hyps = hyps1, tpairs = tpairs1, prop = prop1, ...}) = th1 |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1341 |
and Thm (der2, {maxidx = maxidx2, constraints = constraints2, shyps = shyps2, |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1342 |
hyps = hyps2, tpairs = tpairs2, prop = prop2, ...}) = th2; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1343 |
fun chktypes fT tT = |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1344 |
(case fT of |
32784 | 1345 |
Type ("fun", [T1, _]) => |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1346 |
if T1 <> tT then |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1347 |
raise THM ("combination: types", 0, [th1, th2]) |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1348 |
else () |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1349 |
| _ => raise THM ("combination: not function type", 0, [th1, th2])); |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1350 |
in |
52788 | 1351 |
(case (prop1, prop2) of |
56245 | 1352 |
(Const ("Pure.eq", Type ("fun", [fT, _])) $ f $ g, |
1353 |
Const ("Pure.eq", Type ("fun", [tT, _])) $ t $ u) => |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1354 |
(chktypes fT tT; |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1355 |
Thm (deriv_rule2 (Proofterm.combination f g t u fT) der1 der2, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1356 |
{cert = join_certificate2 (th1, th2), |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1357 |
tags = [], |
68691 | 1358 |
maxidx = Int.max (maxidx1, maxidx2), |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1359 |
constraints = union_constraints constraints1 constraints2, |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1360 |
shyps = Sorts.union shyps1 shyps2, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1361 |
hyps = union_hyps hyps1 hyps2, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1362 |
tpairs = union_tpairs tpairs1 tpairs2, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1363 |
prop = Logic.mk_equals (f $ t, g $ u)})) |
52788 | 1364 |
| _ => raise THM ("combination: premises", 0, [th1, th2])) |
0 | 1365 |
end; |
1366 |
||
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1367 |
(*Equality introduction |
67721 | 1368 |
A \<Longrightarrow> B B \<Longrightarrow> A |
3529 | 1369 |
---------------- |
67721 | 1370 |
A \<equiv> B |
1220 | 1371 |
*) |
0 | 1372 |
fun equal_intr th1 th2 = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1373 |
let |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1374 |
val Thm (der1, {maxidx = maxidx1, constraints = constraints1, shyps = shyps1, |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1375 |
hyps = hyps1, tpairs = tpairs1, prop = prop1, ...}) = th1 |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1376 |
and Thm (der2, {maxidx = maxidx2, constraints = constraints2, shyps = shyps2, |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1377 |
hyps = hyps2, tpairs = tpairs2, prop = prop2, ...}) = th2; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1378 |
fun err msg = raise THM ("equal_intr: " ^ msg, 0, [th1, th2]); |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1379 |
in |
52788 | 1380 |
(case (prop1, prop2) of |
56245 | 1381 |
(Const("Pure.imp", _) $ A $ B, Const("Pure.imp", _) $ B' $ A') => |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1382 |
if A aconv A' andalso B aconv B' then |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1383 |
Thm (deriv_rule2 (Proofterm.equal_intr A B) der1 der2, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1384 |
{cert = join_certificate2 (th1, th2), |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1385 |
tags = [], |
68691 | 1386 |
maxidx = Int.max (maxidx1, maxidx2), |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1387 |
constraints = union_constraints constraints1 constraints2, |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1388 |
shyps = Sorts.union shyps1 shyps2, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1389 |
hyps = union_hyps hyps1 hyps2, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1390 |
tpairs = union_tpairs tpairs1 tpairs2, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1391 |
prop = Logic.mk_equals (A, B)}) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1392 |
else err "not equal" |
52788 | 1393 |
| _ => err "premises") |
1529 | 1394 |
end; |
1395 |
||
1396 |
(*The equal propositions rule |
|
67721 | 1397 |
A \<equiv> B A |
1529 | 1398 |
--------- |
1399 |
B |
|
1400 |
*) |
|
1401 |
fun equal_elim th1 th2 = |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1402 |
let |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1403 |
val Thm (der1, {maxidx = maxidx1, constraints = constraints1, shyps = shyps1, |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1404 |
hyps = hyps1, tpairs = tpairs1, prop = prop1, ...}) = th1 |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1405 |
and Thm (der2, {maxidx = maxidx2, constraints = constraints2, shyps = shyps2, |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1406 |
hyps = hyps2, tpairs = tpairs2, prop = prop2, ...}) = th2; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1407 |
fun err msg = raise THM ("equal_elim: " ^ msg, 0, [th1, th2]); |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1408 |
in |
52788 | 1409 |
(case prop1 of |
56245 | 1410 |
Const ("Pure.eq", _) $ A $ B => |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1411 |
if prop2 aconv A then |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1412 |
Thm (deriv_rule2 (Proofterm.equal_elim A B) der1 der2, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1413 |
{cert = join_certificate2 (th1, th2), |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1414 |
tags = [], |
68691 | 1415 |
maxidx = Int.max (maxidx1, maxidx2), |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1416 |
constraints = union_constraints constraints1 constraints2, |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1417 |
shyps = Sorts.union shyps1 shyps2, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1418 |
hyps = union_hyps hyps1 hyps2, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1419 |
tpairs = union_tpairs tpairs1 tpairs2, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1420 |
prop = B}) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1421 |
else err "not equal" |
52789 | 1422 |
| _ => err "major premise") |
1529 | 1423 |
end; |
0 | 1424 |
|
1220 | 1425 |
|
1426 |
||
0 | 1427 |
(**** Derived rules ****) |
1428 |
||
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1429 |
(*Smash unifies the list of term pairs leaving no flex-flex pairs. |
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
1430 |
Instantiates the theorem and deletes trivial tpairs. Resulting |
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
1431 |
sequence may contain multiple elements if the tpairs are not all |
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
1432 |
flex-flex.*) |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1433 |
fun flexflex_rule opt_ctxt = |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1434 |
solve_constraints #> (fn th => |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1435 |
let |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1436 |
val Thm (der, {cert, maxidx, constraints, shyps, hyps, tpairs, prop, ...}) = th; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1437 |
val (context, cert') = make_context_certificate [th] opt_ctxt cert; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1438 |
in |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1439 |
Unify.smash_unifiers context tpairs (Envir.empty maxidx) |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1440 |
|> Seq.map (fn env => |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1441 |
if Envir.is_empty env then th |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1442 |
else |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1443 |
let |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1444 |
val tpairs' = tpairs |> map (apply2 (Envir.norm_term env)) |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1445 |
(*remove trivial tpairs, of the form t \<equiv> t*) |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1446 |
|> filter_out (op aconv); |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1447 |
val der' = deriv_rule1 (Proofterm.norm_proof' env) der; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1448 |
val constraints' = |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1449 |
insert_constraints_env (Context.certificate_theory cert') env constraints; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1450 |
val prop' = Envir.norm_term env prop; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1451 |
val maxidx = maxidx_tpairs tpairs' (maxidx_of_term prop'); |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1452 |
val shyps = Envir.insert_sorts env shyps; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1453 |
in |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1454 |
Thm (der', {cert = cert', tags = [], maxidx = maxidx, constraints = constraints', |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1455 |
shyps = shyps, hyps = hyps, tpairs = tpairs', prop = prop'}) |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1456 |
end) |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1457 |
end); |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1458 |
|
0 | 1459 |
|
19910 | 1460 |
(*Generalization of fixed variables |
1461 |
A |
|
1462 |
-------------------- |
|
1463 |
A[?'a/'a, ?x/x, ...] |
|
1464 |
*) |
|
1465 |
||
1466 |
fun generalize ([], []) _ th = th |
|
1467 |
| generalize (tfrees, frees) idx th = |
|
1468 |
let |
|
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1469 |
val Thm (der, {cert, maxidx, constraints, shyps, hyps, tpairs, prop, ...}) = th; |
19910 | 1470 |
val _ = idx <= maxidx andalso raise THM ("generalize: bad index", idx, [th]); |
1471 |
||
33697 | 1472 |
val bad_type = |
1473 |
if null tfrees then K false |
|
1474 |
else Term.exists_subtype (fn TFree (a, _) => member (op =) tfrees a | _ => false); |
|
19910 | 1475 |
fun bad_term (Free (x, T)) = bad_type T orelse member (op =) frees x |
1476 |
| bad_term (Var (_, T)) = bad_type T |
|
1477 |
| bad_term (Const (_, T)) = bad_type T |
|
1478 |
| bad_term (Abs (_, T, t)) = bad_type T orelse bad_term t |
|
1479 |
| bad_term (t $ u) = bad_term t orelse bad_term u |
|
1480 |
| bad_term (Bound _) = false; |
|
1481 |
val _ = exists bad_term hyps andalso |
|
1482 |
raise THM ("generalize: variable free in assumptions", 0, [th]); |
|
1483 |
||
31977 | 1484 |
val gen = Term_Subst.generalize (tfrees, frees) idx; |
19910 | 1485 |
val prop' = gen prop; |
59058
a78612c67ec0
renamed "pairself" to "apply2", in accordance to @{apply 2};
wenzelm
parents:
58950
diff
changeset
|
1486 |
val tpairs' = map (apply2 gen) tpairs; |
19910 | 1487 |
val maxidx' = maxidx_tpairs tpairs' (maxidx_of_term prop'); |
1488 |
in |
|
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1489 |
Thm (deriv_rule1 (Proofterm.generalize (tfrees, frees) idx) der, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1490 |
{cert = cert, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1491 |
tags = [], |
19910 | 1492 |
maxidx = maxidx', |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1493 |
constraints = constraints, |
19910 | 1494 |
shyps = shyps, |
1495 |
hyps = hyps, |
|
1496 |
tpairs = tpairs', |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1497 |
prop = prop'}) |
19910 | 1498 |
end; |
1499 |
||
67697 | 1500 |
fun generalize_cterm ([], []) _ ct = ct |
1501 |
| generalize_cterm (tfrees, frees) idx (ct as Cterm {cert, t, T, maxidx, sorts}) = |
|
1502 |
if idx <= maxidx then raise CTERM ("generalize_cterm: bad index", [ct]) |
|
1503 |
else |
|
1504 |
Cterm {cert = cert, sorts = sorts, |
|
1505 |
T = Term_Subst.generalizeT tfrees idx T, |
|
1506 |
t = Term_Subst.generalize (tfrees, frees) idx t, |
|
1507 |
maxidx = Int.max (maxidx, idx)}; |
|
1508 |
||
1509 |
fun generalize_ctyp [] _ cT = cT |
|
1510 |
| generalize_ctyp tfrees idx (Ctyp {cert, T, maxidx, sorts}) = |
|
1511 |
if idx <= maxidx then raise CTERM ("generalize_ctyp: bad index", []) |
|
1512 |
else |
|
1513 |
Ctyp {cert = cert, sorts = sorts, |
|
1514 |
T = Term_Subst.generalizeT tfrees idx T, |
|
1515 |
maxidx = Int.max (maxidx, idx)}; |
|
1516 |
||
19910 | 1517 |
|
22584 | 1518 |
(*Instantiation of schematic variables |
16656 | 1519 |
A |
1520 |
-------------------- |
|
1521 |
A[t1/v1, ..., tn/vn] |
|
1220 | 1522 |
*) |
0 | 1523 |
|
6928 | 1524 |
local |
1525 |
||
26939
1035c89b4c02
moved global pretty/string_of functions from Sign to Syntax;
wenzelm
parents:
26832
diff
changeset
|
1526 |
fun pretty_typing thy t T = Pretty.block |
1035c89b4c02
moved global pretty/string_of functions from Sign to Syntax;
wenzelm
parents:
26832
diff
changeset
|
1527 |
[Syntax.pretty_term_global thy t, Pretty.str " ::", Pretty.brk 1, Syntax.pretty_typ_global thy T]; |
15797 | 1528 |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1529 |
fun add_inst (v as (_, T), cu) (cert, sorts) = |
6928 | 1530 |
let |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1531 |
val Cterm {t = u, T = U, cert = cert2, sorts = sorts_u, maxidx = maxidx_u, ...} = cu; |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1532 |
val cert' = Context.join_certificate (cert, cert2); |
16884
1678a796b6b2
tuned instantiate (avoid subst_atomic, subst_atomic_types);
wenzelm
parents:
16847
diff
changeset
|
1533 |
val sorts' = Sorts.union sorts_u sorts; |
3967
edd5ff9371f8
sg_ref: automatic adjustment of thms of draft theories;
wenzelm
parents:
3895
diff
changeset
|
1534 |
in |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1535 |
if T = U then ((v, (u, maxidx_u)), (cert', sorts')) |
60642
48dd1cefb4ae
simplified Thm.instantiate and derivatives: the LHS refers to non-certified variables -- this merely serves as index into already certified structures (or is ignored);
wenzelm
parents:
60638
diff
changeset
|
1536 |
else |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1537 |
let |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1538 |
val msg = |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1539 |
(case cert' of |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1540 |
Context.Certificate thy' => |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1541 |
Pretty.string_of (Pretty.block |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1542 |
[Pretty.str "instantiate: type conflict", |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1543 |
Pretty.fbrk, pretty_typing thy' (Var v) T, |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1544 |
Pretty.fbrk, pretty_typing thy' u U]) |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1545 |
| Context.Certificate_Id _ => "instantiate: type conflict"); |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1546 |
in raise TYPE (msg, [T, U], [Var v, u]) end |
0 | 1547 |
end; |
1548 |
||
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1549 |
fun add_instT (v as (_, S), cU) (cert, sorts) = |
16656 | 1550 |
let |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1551 |
val Ctyp {T = U, cert = cert2, sorts = sorts_U, maxidx = maxidx_U, ...} = cU; |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1552 |
val cert' = Context.join_certificate (cert, cert2); |
61051 | 1553 |
val thy' = Context.certificate_theory cert' |
1554 |
handle ERROR msg => raise CONTEXT (msg, [cU], [], [], NONE); |
|
16884
1678a796b6b2
tuned instantiate (avoid subst_atomic, subst_atomic_types);
wenzelm
parents:
16847
diff
changeset
|
1555 |
val sorts' = Sorts.union sorts_U sorts; |
16656 | 1556 |
in |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1557 |
if Sign.of_sort thy' (U, S) then ((v, (U, maxidx_U)), (cert', sorts')) |
60642
48dd1cefb4ae
simplified Thm.instantiate and derivatives: the LHS refers to non-certified variables -- this merely serves as index into already certified structures (or is ignored);
wenzelm
parents:
60638
diff
changeset
|
1558 |
else raise TYPE ("Type not of sort " ^ Syntax.string_of_sort_global thy' S, [U], []) |
16656 | 1559 |
end; |
0 | 1560 |
|
6928 | 1561 |
in |
1562 |
||
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1563 |
(*Left-to-right replacements: ctpairs = [..., (vi, ti), ...]. |
0 | 1564 |
Instantiates distinct Vars by terms of same type. |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1565 |
Does NOT normalize the resulting theorem!*) |
1529 | 1566 |
fun instantiate ([], []) th = th |
16884
1678a796b6b2
tuned instantiate (avoid subst_atomic, subst_atomic_types);
wenzelm
parents:
16847
diff
changeset
|
1567 |
| instantiate (instT, inst) th = |
16656 | 1568 |
let |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1569 |
val Thm (der, {cert, hyps, constraints, shyps, tpairs, prop, ...}) = th; |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1570 |
val (inst', (instT', (cert', shyps'))) = |
61051 | 1571 |
(cert, shyps) |> fold_map add_inst inst ||> fold_map add_instT instT |
61053 | 1572 |
handle CONTEXT (msg, cTs, cts, ths, context) => |
1573 |
raise CONTEXT (msg, cTs, cts, th :: ths, context); |
|
31977 | 1574 |
val subst = Term_Subst.instantiate_maxidx (instT', inst'); |
20512 | 1575 |
val (prop', maxidx1) = subst prop ~1; |
1576 |
val (tpairs', maxidx') = |
|
1577 |
fold_map (fn (t, u) => fn i => subst t i ||>> subst u) tpairs maxidx1; |
|
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1578 |
|
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1579 |
val thy' = Context.certificate_theory cert'; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1580 |
val constraints' = |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1581 |
fold (fn ((_, S), (T, _)) => insert_constraints thy' (T, S)) instT' constraints; |
16656 | 1582 |
in |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1583 |
Thm (deriv_rule1 |
37309 | 1584 |
(fn d => Proofterm.instantiate (map (apsnd #1) instT', map (apsnd #1) inst') d) der, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1585 |
{cert = cert', |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1586 |
tags = [], |
20545
4c1068697159
instantiate: omit has_duplicates check, which is irrelevant for soundness;
wenzelm
parents:
20512
diff
changeset
|
1587 |
maxidx = maxidx', |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1588 |
constraints = constraints', |
20545
4c1068697159
instantiate: omit has_duplicates check, which is irrelevant for soundness;
wenzelm
parents:
20512
diff
changeset
|
1589 |
shyps = shyps', |
4c1068697159
instantiate: omit has_duplicates check, which is irrelevant for soundness;
wenzelm
parents:
20512
diff
changeset
|
1590 |
hyps = hyps, |
4c1068697159
instantiate: omit has_duplicates check, which is irrelevant for soundness;
wenzelm
parents:
20512
diff
changeset
|
1591 |
tpairs = tpairs', |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1592 |
prop = prop'}) |
70472
cf66d2db97fe
more robust and convenient treatment of implicit context;
wenzelm
parents:
70469
diff
changeset
|
1593 |
|> solve_constraints |
16656 | 1594 |
end |
1595 |
handle TYPE (msg, _, _) => raise THM (msg, 0, [th]); |
|
6928 | 1596 |
|
22584 | 1597 |
fun instantiate_cterm ([], []) ct = ct |
1598 |
| instantiate_cterm (instT, inst) ct = |
|
1599 |
let |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1600 |
val Cterm {cert, t, T, sorts, ...} = ct; |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1601 |
val (inst', (instT', (cert', sorts'))) = |
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1602 |
(cert, sorts) |> fold_map add_inst inst ||> fold_map add_instT instT; |
31977 | 1603 |
val subst = Term_Subst.instantiate_maxidx (instT', inst'); |
1604 |
val substT = Term_Subst.instantiateT_maxidx instT'; |
|
22584 | 1605 |
val (t', maxidx1) = subst t ~1; |
1606 |
val (T', maxidx') = substT T maxidx1; |
|
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1607 |
in Cterm {cert = cert', t = t', T = T', sorts = sorts', maxidx = maxidx'} end |
22584 | 1608 |
handle TYPE (msg, _, _) => raise CTERM (msg, [ct]); |
1609 |
||
6928 | 1610 |
end; |
1611 |
||
0 | 1612 |
|
67721 | 1613 |
(*The trivial implication A \<Longrightarrow> A, justified by assume and forall rules. |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1614 |
A can contain Vars, not so for assume!*) |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1615 |
fun trivial (Cterm {cert, t = A, T, maxidx, sorts}) = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1616 |
if T <> propT then |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1617 |
raise THM ("trivial: the term must have type prop", 0, []) |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1618 |
else |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1619 |
Thm (deriv_rule0 (Proofterm.AbsP ("H", NONE, Proofterm.PBound 0)), |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1620 |
{cert = cert, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1621 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1622 |
maxidx = maxidx, |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1623 |
constraints = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1624 |
shyps = sorts, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1625 |
hyps = [], |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1626 |
tpairs = [], |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1627 |
prop = Logic.mk_implies (A, A)}); |
0 | 1628 |
|
31944 | 1629 |
(*Axiom-scheme reflecting signature contents |
1630 |
T :: c |
|
1631 |
------------------- |
|
1632 |
OFCLASS(T, c_class) |
|
1633 |
*) |
|
1634 |
fun of_class (cT, raw_c) = |
|
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
1635 |
let |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1636 |
val Ctyp {cert, T, ...} = cT; |
61051 | 1637 |
val thy = Context.certificate_theory cert |
1638 |
handle ERROR msg => raise CONTEXT (msg, [cT], [], [], NONE); |
|
31903 | 1639 |
val c = Sign.certify_class thy raw_c; |
59621
291934bac95e
Thm.cterm_of and Thm.ctyp_of operate on local context;
wenzelm
parents:
59591
diff
changeset
|
1640 |
val Cterm {t = prop, maxidx, sorts, ...} = global_cterm_of thy (Logic.mk_of_class (T, c)); |
399
86cc2b98f9e0
added class_triv: theory -> class -> thm (for axclasses);
wenzelm
parents:
387
diff
changeset
|
1641 |
in |
31944 | 1642 |
if Sign.of_sort thy (T, [c]) then |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1643 |
Thm (deriv_rule0 (Proofterm.OfClass (T, c)), |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1644 |
{cert = cert, |
31944 | 1645 |
tags = [], |
1646 |
maxidx = maxidx, |
|
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1647 |
constraints = insert_constraints thy (T, [c]) [], |
31944 | 1648 |
shyps = sorts, |
1649 |
hyps = [], |
|
1650 |
tpairs = [], |
|
1651 |
prop = prop}) |
|
1652 |
else raise THM ("of_class: type not of class " ^ Syntax.string_of_sort_global thy [c], 0, []) |
|
70482
d4b5139eea34
more robust and convenient treatment of implicit context;
wenzelm
parents:
70480
diff
changeset
|
1653 |
end |> solve_constraints; |
399
86cc2b98f9e0
added class_triv: theory -> class -> thm (for axclasses);
wenzelm
parents:
387
diff
changeset
|
1654 |
|
36614
b6c031ad3690
minor tuning of Thm.strip_shyps -- no longer pervasive;
wenzelm
parents:
36613
diff
changeset
|
1655 |
(*Remove extra sorts that are witnessed by type signature information*) |
b6c031ad3690
minor tuning of Thm.strip_shyps -- no longer pervasive;
wenzelm
parents:
36613
diff
changeset
|
1656 |
fun strip_shyps (thm as Thm (_, {shyps = [], ...})) = thm |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1657 |
| strip_shyps (thm as Thm (der, {cert, tags, maxidx, constraints, shyps, hyps, tpairs, prop})) = |
36614
b6c031ad3690
minor tuning of Thm.strip_shyps -- no longer pervasive;
wenzelm
parents:
36613
diff
changeset
|
1658 |
let |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1659 |
val thy = theory_of_thm thm; |
36621
2fd4e2c76636
proof terms for strip_shyps, based on the version by krauss/schropp with some notable differences:
wenzelm
parents:
36619
diff
changeset
|
1660 |
val algebra = Sign.classes_of thy; |
2fd4e2c76636
proof terms for strip_shyps, based on the version by krauss/schropp with some notable differences:
wenzelm
parents:
36619
diff
changeset
|
1661 |
|
2fd4e2c76636
proof terms for strip_shyps, based on the version by krauss/schropp with some notable differences:
wenzelm
parents:
36619
diff
changeset
|
1662 |
val present = (fold_terms o fold_types o fold_atyps_sorts) (insert (eq_fst op =)) thm []; |
36614
b6c031ad3690
minor tuning of Thm.strip_shyps -- no longer pervasive;
wenzelm
parents:
36613
diff
changeset
|
1663 |
val extra = fold (Sorts.remove_sort o #2) present shyps; |
b6c031ad3690
minor tuning of Thm.strip_shyps -- no longer pervasive;
wenzelm
parents:
36613
diff
changeset
|
1664 |
val witnessed = Sign.witness_sorts thy present extra; |
b6c031ad3690
minor tuning of Thm.strip_shyps -- no longer pervasive;
wenzelm
parents:
36613
diff
changeset
|
1665 |
val extra' = fold (Sorts.remove_sort o #2) witnessed extra |
36621
2fd4e2c76636
proof terms for strip_shyps, based on the version by krauss/schropp with some notable differences:
wenzelm
parents:
36619
diff
changeset
|
1666 |
|> Sorts.minimal_sorts algebra; |
36614
b6c031ad3690
minor tuning of Thm.strip_shyps -- no longer pervasive;
wenzelm
parents:
36613
diff
changeset
|
1667 |
val shyps' = fold (Sorts.insert_sort o #2) present extra'; |
b6c031ad3690
minor tuning of Thm.strip_shyps -- no longer pervasive;
wenzelm
parents:
36613
diff
changeset
|
1668 |
in |
37309 | 1669 |
Thm (deriv_rule_unconditional |
1670 |
(Proofterm.strip_shyps_proof algebra present witnessed extra') der, |
|
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1671 |
{cert = cert, tags = tags, maxidx = maxidx, constraints = constraints, |
36614
b6c031ad3690
minor tuning of Thm.strip_shyps -- no longer pervasive;
wenzelm
parents:
36613
diff
changeset
|
1672 |
shyps = shyps', hyps = hyps, tpairs = tpairs, prop = prop}) |
b6c031ad3690
minor tuning of Thm.strip_shyps -- no longer pervasive;
wenzelm
parents:
36613
diff
changeset
|
1673 |
end; |
b6c031ad3690
minor tuning of Thm.strip_shyps -- no longer pervasive;
wenzelm
parents:
36613
diff
changeset
|
1674 |
|
36769
b6b88bf695b3
Thm.unconstrainT based on Logic.unconstrainT -- no proofterm yet;
wenzelm
parents:
36768
diff
changeset
|
1675 |
(*Internalize sort constraints of type variables*) |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1676 |
val unconstrainT = |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1677 |
solve_constraints #> (fn thm as Thm (der, args) => |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1678 |
let |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1679 |
val Deriv {promises, body} = der; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1680 |
val {cert, shyps, hyps, tpairs, prop, ...} = args; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1681 |
val thy = theory_of_thm thm; |
36883
4ed0d72def50
added Proofterm.unconstrain_thm_proof for Thm.unconstrainT -- loosely based on the version by krauss/schropp;
wenzelm
parents:
36882
diff
changeset
|
1682 |
|
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1683 |
fun err msg = raise THM ("unconstrainT: " ^ msg, 0, [thm]); |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1684 |
val _ = null hyps orelse err "bad hyps"; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1685 |
val _ = null tpairs orelse err "bad flex-flex constraints"; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1686 |
val tfrees = rev (Term.add_tfree_names prop []); |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1687 |
val _ = null tfrees orelse err ("illegal free type variables " ^ commas_quote tfrees); |
36769
b6b88bf695b3
Thm.unconstrainT based on Logic.unconstrainT -- no proofterm yet;
wenzelm
parents:
36768
diff
changeset
|
1688 |
|
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1689 |
val ps = map (apsnd (Future.map fulfill_body)) promises; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1690 |
val (pthm, proof) = |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1691 |
Proofterm.unconstrain_thm_proof thy (classrel_proof thy) (arity_proof thy) shyps prop ps body; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1692 |
val der' = make_deriv [] [] [pthm] proof; |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1693 |
val prop' = Proofterm.thm_node_prop (#2 pthm); |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1694 |
in |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1695 |
Thm (der', |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1696 |
{cert = cert, |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1697 |
tags = [], |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1698 |
maxidx = maxidx_of_term prop', |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1699 |
constraints = [], |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1700 |
shyps = [[]], (*potentially redundant*) |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1701 |
hyps = [], |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1702 |
tpairs = [], |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1703 |
prop = prop'}) |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1704 |
end); |
399
86cc2b98f9e0
added class_triv: theory -> class -> thm (for axclasses);
wenzelm
parents:
387
diff
changeset
|
1705 |
|
63611 | 1706 |
(*Replace all TFrees not fixed or in the hyps by new TVars*) |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1707 |
fun varifyT_global' fixed (Thm (der, {cert, maxidx, constraints, shyps, hyps, tpairs, prop, ...})) = |
12500 | 1708 |
let |
29272 | 1709 |
val tfrees = fold Term.add_tfrees hyps fixed; |
13658
c9ad3e64ddcf
Changed handling of flex-flex constraints: now stored in separate
berghofe
parents:
13642
diff
changeset
|
1710 |
val prop1 = attach_tpairs tpairs prop; |
35845
e5980f0ad025
renamed varify/unvarify operations to varify_global/unvarify_global to emphasize that these only work in a global situation;
wenzelm
parents:
35408
diff
changeset
|
1711 |
val (al, prop2) = Type.varify_global tfrees prop1; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1712 |
val (ts, prop3) = Logic.strip_prems (length tpairs, [], prop2); |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1713 |
in |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1714 |
(al, Thm (deriv_rule1 (Proofterm.varify_proof prop tfrees) der, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1715 |
{cert = cert, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1716 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1717 |
maxidx = Int.max (0, maxidx), |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1718 |
constraints = constraints, |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1719 |
shyps = shyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1720 |
hyps = hyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1721 |
tpairs = rev (map Logic.dest_equals ts), |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1722 |
prop = prop3})) |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1723 |
end; |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1724 |
|
35845
e5980f0ad025
renamed varify/unvarify operations to varify_global/unvarify_global to emphasize that these only work in a global situation;
wenzelm
parents:
35408
diff
changeset
|
1725 |
val varifyT_global = #2 o varifyT_global' []; |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1726 |
|
63611 | 1727 |
(*Replace all TVars by TFrees that are often new*) |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1728 |
fun legacy_freezeT (Thm (der, {cert, constraints, shyps, hyps, tpairs, prop, ...})) = |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1729 |
let |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1730 |
val prop1 = attach_tpairs tpairs prop; |
33832 | 1731 |
val prop2 = Type.legacy_freeze prop1; |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1732 |
val (ts, prop3) = Logic.strip_prems (length tpairs, [], prop2); |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1733 |
in |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1734 |
Thm (deriv_rule1 (Proofterm.legacy_freezeT prop1) der, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1735 |
{cert = cert, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1736 |
tags = [], |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1737 |
maxidx = maxidx_of_term prop2, |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1738 |
constraints = constraints, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1739 |
shyps = shyps, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1740 |
hyps = hyps, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1741 |
tpairs = rev (map Logic.dest_equals ts), |
18127 | 1742 |
prop = prop3}) |
0 | 1743 |
end; |
1744 |
||
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
1745 |
fun plain_prop_of raw_thm = |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
1746 |
let |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
1747 |
val thm = strip_shyps raw_thm; |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
1748 |
fun err msg = raise THM ("plain_prop_of: " ^ msg, 0, [thm]); |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
1749 |
in |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
1750 |
if not (null (hyps_of thm)) then |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
1751 |
err "theorem may not contain hypotheses" |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
1752 |
else if not (null (extra_shyps thm)) then |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
1753 |
err "theorem may not contain sort hypotheses" |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
1754 |
else if not (null (tpairs_of thm)) then |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
1755 |
err "theorem may not contain flex-flex pairs" |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
1756 |
else prop_of thm |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
1757 |
end; |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
1758 |
|
0 | 1759 |
|
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1760 |
|
0 | 1761 |
(*** Inference rules for tactics ***) |
1762 |
||
1763 |
(*Destruct proof state into constraints, other goals, goal(i), rest *) |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1764 |
fun dest_state (state as Thm (_, {prop,tpairs,...}), i) = |
13658
c9ad3e64ddcf
Changed handling of flex-flex constraints: now stored in separate
berghofe
parents:
13642
diff
changeset
|
1765 |
(case Logic.strip_prems(i, [], prop) of |
c9ad3e64ddcf
Changed handling of flex-flex constraints: now stored in separate
berghofe
parents:
13642
diff
changeset
|
1766 |
(B::rBs, C) => (tpairs, rev rBs, B, C) |
c9ad3e64ddcf
Changed handling of flex-flex constraints: now stored in separate
berghofe
parents:
13642
diff
changeset
|
1767 |
| _ => raise THM("dest_state", i, [state])) |
0 | 1768 |
handle TERM _ => raise THM("dest_state", i, [state]); |
1769 |
||
46255 | 1770 |
(*Prepare orule for resolution by lifting it over the parameters and |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1771 |
assumptions of goal.*) |
18035 | 1772 |
fun lift_rule goal orule = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1773 |
let |
18035 | 1774 |
val Cterm {t = gprop, T, maxidx = gmax, sorts, ...} = goal; |
1775 |
val inc = gmax + 1; |
|
1776 |
val lift_abs = Logic.lift_abs inc gprop; |
|
1777 |
val lift_all = Logic.lift_all inc gprop; |
|
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1778 |
val Thm (der, {maxidx, constraints, shyps, hyps, tpairs, prop, ...}) = orule; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1779 |
val (As, B) = Logic.strip_horn prop; |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1780 |
in |
18035 | 1781 |
if T <> propT then raise THM ("lift_rule: the term must have type prop", 0, []) |
1782 |
else |
|
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1783 |
Thm (deriv_rule1 (Proofterm.lift_proof gprop inc prop) der, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1784 |
{cert = join_certificate1 (goal, orule), |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1785 |
tags = [], |
18035 | 1786 |
maxidx = maxidx + inc, |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1787 |
constraints = constraints, |
18035 | 1788 |
shyps = Sorts.union shyps sorts, (*sic!*) |
1789 |
hyps = hyps, |
|
59058
a78612c67ec0
renamed "pairself" to "apply2", in accordance to @{apply 2};
wenzelm
parents:
58950
diff
changeset
|
1790 |
tpairs = map (apply2 lift_abs) tpairs, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1791 |
prop = Logic.list_implies (map lift_all As, lift_all B)}) |
0 | 1792 |
end; |
1793 |
||
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1794 |
fun incr_indexes i (thm as Thm (der, {cert, maxidx, constraints, shyps, hyps, tpairs, prop, ...})) = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1795 |
if i < 0 then raise THM ("negative increment", 0, [thm]) |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1796 |
else if i = 0 then thm |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1797 |
else |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1798 |
Thm (deriv_rule1 (Proofterm.incr_indexes i) der, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1799 |
{cert = cert, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1800 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1801 |
maxidx = maxidx + i, |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1802 |
constraints = constraints, |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1803 |
shyps = shyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1804 |
hyps = hyps, |
59787 | 1805 |
tpairs = map (apply2 (Logic.incr_indexes ([], [], i))) tpairs, |
1806 |
prop = Logic.incr_indexes ([], [], i) prop}); |
|
10416
5b33e732e459
- Moved rewriting functions to meta_simplifier.ML
berghofe
parents:
10348
diff
changeset
|
1807 |
|
0 | 1808 |
(*Solve subgoal Bi of proof state B1...Bn/C by assumption. *) |
58950
d07464875dd4
optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents:
58946
diff
changeset
|
1809 |
fun assumption opt_ctxt i state = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1810 |
let |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1811 |
val Thm (der, {cert, maxidx, constraints, shyps, hyps, ...}) = state; |
64981
ea6199b23dfa
proper background certificate from make_context, which can be a super-theory of the direct join (amending d07464875dd4);
wenzelm
parents:
64574
diff
changeset
|
1812 |
val (context, cert') = make_context_certificate [state] opt_ctxt cert; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1813 |
val (tpairs, Bs, Bi, C) = dest_state (state, i); |
32032 | 1814 |
fun newth n (env, tpairs) = |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1815 |
Thm (deriv_rule1 |
63858 | 1816 |
((if Envir.is_empty env then I else Proofterm.norm_proof' env) o |
37309 | 1817 |
Proofterm.assumption_proof Bs Bi n) der, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1818 |
{tags = [], |
32032 | 1819 |
maxidx = Envir.maxidx_of env, |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1820 |
constraints = insert_constraints_env (Context.certificate_theory cert') env constraints, |
26640
92e6d3ec91bd
simplified handling of sorts, removed unnecessary universal witness;
wenzelm
parents:
26631
diff
changeset
|
1821 |
shyps = Envir.insert_sorts env shyps, |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1822 |
hyps = hyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1823 |
tpairs = |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1824 |
if Envir.is_empty env then tpairs |
59058
a78612c67ec0
renamed "pairself" to "apply2", in accordance to @{apply 2};
wenzelm
parents:
58950
diff
changeset
|
1825 |
else map (apply2 (Envir.norm_term env)) tpairs, |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1826 |
prop = |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1827 |
if Envir.is_empty env then (*avoid wasted normalizations*) |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1828 |
Logic.list_implies (Bs, C) |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1829 |
else (*normalize the new rule fully*) |
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
1830 |
Envir.norm_term env (Logic.list_implies (Bs, C)), |
64981
ea6199b23dfa
proper background certificate from make_context, which can be a super-theory of the direct join (amending d07464875dd4);
wenzelm
parents:
64574
diff
changeset
|
1831 |
cert = cert'}); |
30554
73f8bd5f0af8
substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents:
30466
diff
changeset
|
1832 |
|
30556
7be15917f3fa
eq_assumption: slightly more efficient by checking (open) result of Logic.assum_problems directly;
wenzelm
parents:
30554
diff
changeset
|
1833 |
val (close, asms, concl) = Logic.assum_problems (~1, Bi); |
7be15917f3fa
eq_assumption: slightly more efficient by checking (open) result of Logic.assum_problems directly;
wenzelm
parents:
30554
diff
changeset
|
1834 |
val concl' = close concl; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1835 |
fun addprfs [] _ = Seq.empty |
30556
7be15917f3fa
eq_assumption: slightly more efficient by checking (open) result of Logic.assum_problems directly;
wenzelm
parents:
30554
diff
changeset
|
1836 |
| addprfs (asm :: rest) n = Seq.make (fn () => Seq.pull |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1837 |
(Seq.mapp (newth n) |
30556
7be15917f3fa
eq_assumption: slightly more efficient by checking (open) result of Logic.assum_problems directly;
wenzelm
parents:
30554
diff
changeset
|
1838 |
(if Term.could_unify (asm, concl) then |
58950
d07464875dd4
optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents:
58946
diff
changeset
|
1839 |
(Unify.unifiers (context, Envir.empty maxidx, (close asm, concl') :: tpairs)) |
30554
73f8bd5f0af8
substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents:
30466
diff
changeset
|
1840 |
else Seq.empty) |
73f8bd5f0af8
substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents:
30466
diff
changeset
|
1841 |
(addprfs rest (n + 1)))) |
30556
7be15917f3fa
eq_assumption: slightly more efficient by checking (open) result of Logic.assum_problems directly;
wenzelm
parents:
30554
diff
changeset
|
1842 |
in addprfs asms 1 end; |
0 | 1843 |
|
250 | 1844 |
(*Solve subgoal Bi of proof state B1...Bn/C by assumption. |
51604 | 1845 |
Checks if Bi's conclusion is alpha/eta-convertible to one of its assumptions*) |
0 | 1846 |
fun eq_assumption i state = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1847 |
let |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1848 |
val Thm (der, {cert, maxidx, constraints, shyps, hyps, ...}) = state; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1849 |
val (tpairs, Bs, Bi, C) = dest_state (state, i); |
30556
7be15917f3fa
eq_assumption: slightly more efficient by checking (open) result of Logic.assum_problems directly;
wenzelm
parents:
30554
diff
changeset
|
1850 |
val (_, asms, concl) = Logic.assum_problems (~1, Bi); |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1851 |
in |
52131 | 1852 |
(case find_index (fn asm => Envir.aeconv (asm, concl)) asms of |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1853 |
~1 => raise THM ("eq_assumption", 0, [state]) |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1854 |
| n => |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1855 |
Thm (deriv_rule1 (Proofterm.assumption_proof Bs Bi (n + 1)) der, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1856 |
{cert = cert, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1857 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1858 |
maxidx = maxidx, |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1859 |
constraints = constraints, |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1860 |
shyps = shyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1861 |
hyps = hyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1862 |
tpairs = tpairs, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1863 |
prop = Logic.list_implies (Bs, C)})) |
0 | 1864 |
end; |
1865 |
||
1866 |
||
2671 | 1867 |
(*For rotate_tac: fast rotation of assumptions of subgoal i*) |
1868 |
fun rotate_rule k i state = |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1869 |
let |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1870 |
val Thm (der, {cert, maxidx, constraints, shyps, hyps, ...}) = state; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1871 |
val (tpairs, Bs, Bi, C) = dest_state (state, i); |
46218
ecf6375e2abb
renamed Term.list_all to Logic.list_all, in accordance to HOLogic.list_all;
wenzelm
parents:
46217
diff
changeset
|
1872 |
val params = Term.strip_all_vars Bi; |
ecf6375e2abb
renamed Term.list_all to Logic.list_all, in accordance to HOLogic.list_all;
wenzelm
parents:
46217
diff
changeset
|
1873 |
val rest = Term.strip_all_body Bi; |
ecf6375e2abb
renamed Term.list_all to Logic.list_all, in accordance to HOLogic.list_all;
wenzelm
parents:
46217
diff
changeset
|
1874 |
val asms = Logic.strip_imp_prems rest |
ecf6375e2abb
renamed Term.list_all to Logic.list_all, in accordance to HOLogic.list_all;
wenzelm
parents:
46217
diff
changeset
|
1875 |
val concl = Logic.strip_imp_concl rest; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1876 |
val n = length asms; |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1877 |
val m = if k < 0 then n + k else k; |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1878 |
val Bi' = |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1879 |
if 0 = m orelse m = n then Bi |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1880 |
else if 0 < m andalso m < n then |
19012 | 1881 |
let val (ps, qs) = chop m asms |
46218
ecf6375e2abb
renamed Term.list_all to Logic.list_all, in accordance to HOLogic.list_all;
wenzelm
parents:
46217
diff
changeset
|
1882 |
in Logic.list_all (params, Logic.list_implies (qs @ ps, concl)) end |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1883 |
else raise THM ("rotate_rule", k, [state]); |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1884 |
in |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1885 |
Thm (deriv_rule1 (Proofterm.rotate_proof Bs Bi m) der, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1886 |
{cert = cert, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1887 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1888 |
maxidx = maxidx, |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1889 |
constraints = constraints, |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1890 |
shyps = shyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1891 |
hyps = hyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1892 |
tpairs = tpairs, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1893 |
prop = Logic.list_implies (Bs @ [Bi'], C)}) |
2671 | 1894 |
end; |
1895 |
||
1896 |
||
7248
322151fe6f02
new primitive rule permute_prems to underlie defer_tac and rotate_prems
paulson
parents:
7070
diff
changeset
|
1897 |
(*Rotates a rule's premises to the left by k, leaving the first j premises |
322151fe6f02
new primitive rule permute_prems to underlie defer_tac and rotate_prems
paulson
parents:
7070
diff
changeset
|
1898 |
unchanged. Does nothing if k=0 or if k equals n-j, where n is the |
58837 | 1899 |
number of premises. Useful with eresolve_tac and underlies defer_tac*) |
7248
322151fe6f02
new primitive rule permute_prems to underlie defer_tac and rotate_prems
paulson
parents:
7070
diff
changeset
|
1900 |
fun permute_prems j k rl = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1901 |
let |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1902 |
val Thm (der, {cert, maxidx, constraints, shyps, hyps, tpairs, prop, ...}) = rl; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1903 |
val prems = Logic.strip_imp_prems prop |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1904 |
and concl = Logic.strip_imp_concl prop; |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1905 |
val moved_prems = List.drop (prems, j) |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1906 |
and fixed_prems = List.take (prems, j) |
43278 | 1907 |
handle General.Subscript => raise THM ("permute_prems: j", j, [rl]); |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1908 |
val n_j = length moved_prems; |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1909 |
val m = if k < 0 then n_j + k else k; |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1910 |
val prop' = |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1911 |
if 0 = m orelse m = n_j then prop |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1912 |
else if 0 < m andalso m < n_j then |
19012 | 1913 |
let val (ps, qs) = chop m moved_prems |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1914 |
in Logic.list_implies (fixed_prems @ qs @ ps, concl) end |
16725 | 1915 |
else raise THM ("permute_prems: k", k, [rl]); |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1916 |
in |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
1917 |
Thm (deriv_rule1 (Proofterm.permute_prems_proof prems j m) der, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
1918 |
{cert = cert, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1919 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1920 |
maxidx = maxidx, |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1921 |
constraints = constraints, |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1922 |
shyps = shyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1923 |
hyps = hyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1924 |
tpairs = tpairs, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1925 |
prop = prop'}) |
7248
322151fe6f02
new primitive rule permute_prems to underlie defer_tac and rotate_prems
paulson
parents:
7070
diff
changeset
|
1926 |
end; |
322151fe6f02
new primitive rule permute_prems to underlie defer_tac and rotate_prems
paulson
parents:
7070
diff
changeset
|
1927 |
|
322151fe6f02
new primitive rule permute_prems to underlie defer_tac and rotate_prems
paulson
parents:
7070
diff
changeset
|
1928 |
|
44108
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1929 |
(* strip_apply f B A strips off all assumptions/parameters from A |
0 | 1930 |
introduced by lifting over B, and applies f to remaining part of A*) |
1931 |
fun strip_apply f = |
|
56245 | 1932 |
let fun strip (Const ("Pure.imp", _) $ _ $ B1) |
1933 |
(Const ("Pure.imp", _) $ A2 $ B2) = Logic.mk_implies (A2, strip B1 B2) |
|
1934 |
| strip ((c as Const ("Pure.all", _)) $ Abs (_, _, t1)) |
|
1935 |
( Const ("Pure.all", _) $ Abs (a, T, t2)) = c $ Abs (a, T, strip t1 t2) |
|
44108
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1936 |
| strip _ A = f A |
0 | 1937 |
in strip end; |
1938 |
||
56245 | 1939 |
fun strip_lifted (Const ("Pure.imp", _) $ _ $ B1) |
1940 |
(Const ("Pure.imp", _) $ _ $ B2) = strip_lifted B1 B2 |
|
1941 |
| strip_lifted (Const ("Pure.all", _) $ Abs (_, _, t1)) |
|
1942 |
(Const ("Pure.all", _) $ Abs (_, _, t2)) = strip_lifted t1 t2 |
|
44108
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1943 |
| strip_lifted _ A = A; |
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1944 |
|
0 | 1945 |
(*Use the alist to rename all bound variables and some unknowns in a term |
1946 |
dpairs = current disagreement pairs; tpairs = permanent ones (flexflex); |
|
1947 |
Preserves unknowns in tpairs and on lhs of dpairs. *) |
|
44108
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1948 |
fun rename_bvs [] _ _ _ _ = K I |
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1949 |
| rename_bvs al dpairs tpairs B As = |
20330 | 1950 |
let |
1951 |
val add_var = fold_aterms (fn Var ((x, _), _) => insert (op =) x | _ => I); |
|
1952 |
val vids = [] |
|
1953 |
|> fold (add_var o fst) dpairs |
|
1954 |
|> fold (add_var o fst) tpairs |
|
1955 |
|> fold (add_var o snd) tpairs; |
|
44108
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1956 |
val vids' = fold (add_var o strip_lifted B) As []; |
250 | 1957 |
(*unknowns appearing elsewhere be preserved!*) |
59058
a78612c67ec0
renamed "pairself" to "apply2", in accordance to @{apply 2};
wenzelm
parents:
58950
diff
changeset
|
1958 |
val al' = distinct ((op =) o apply2 fst) |
44108
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1959 |
(filter_out (fn (x, y) => |
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1960 |
not (member (op =) vids' x) orelse |
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1961 |
member (op =) vids x orelse member (op =) vids y) al); |
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1962 |
val unchanged = filter_out (AList.defined (op =) al') vids'; |
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1963 |
fun del_clashing clash xs _ [] qs = |
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1964 |
if clash then del_clashing false xs xs qs [] else qs |
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1965 |
| del_clashing clash xs ys ((p as (x, y)) :: ps) qs = |
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1966 |
if member (op =) ys y |
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1967 |
then del_clashing true (x :: xs) (x :: ys) ps qs |
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1968 |
else del_clashing clash xs (y :: ys) ps (p :: qs); |
46497
89ccf66aa73d
renamed Thm.capply to Thm.apply, and Thm.cabs to Thm.lambda in conformance with similar operations in structure Term and Logic;
wenzelm
parents:
46475
diff
changeset
|
1969 |
val al'' = del_clashing false unchanged unchanged al' []; |
44108
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1970 |
fun rename (t as Var ((x, i), T)) = |
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1971 |
(case AList.lookup (op =) al'' x of |
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1972 |
SOME y => Var ((y, i), T) |
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1973 |
| NONE => t) |
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1974 |
| rename (Abs (x, T, t)) = |
18944 | 1975 |
Abs (the_default x (AList.lookup (op =) al x), T, rename t) |
44108
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1976 |
| rename (f $ t) = rename f $ rename t |
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1977 |
| rename t = t; |
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1978 |
fun strip_ren f Ai = f rename B Ai |
20330 | 1979 |
in strip_ren end; |
0 | 1980 |
|
1981 |
(*Function to rename bounds/unknowns in the argument, lifted over B*) |
|
44108
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
1982 |
fun rename_bvars dpairs = |
48263 | 1983 |
rename_bvs (fold_rev Term.match_bvars dpairs []) dpairs; |
0 | 1984 |
|
1985 |
||
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
1986 |
|
0 | 1987 |
(*** RESOLUTION ***) |
1988 |
||
721
479832ff2d29
Pure/thm/norm_term_skip: new, for skipping normalization of the context
lcp
parents:
678
diff
changeset
|
1989 |
(** Lifting optimizations **) |
479832ff2d29
Pure/thm/norm_term_skip: new, for skipping normalization of the context
lcp
parents:
678
diff
changeset
|
1990 |
|
0 | 1991 |
(*strip off pairs of assumptions/parameters in parallel -- they are |
1992 |
identical because of lifting*) |
|
56245 | 1993 |
fun strip_assums2 (Const("Pure.imp", _) $ _ $ B1, |
1994 |
Const("Pure.imp", _) $ _ $ B2) = strip_assums2 (B1,B2) |
|
1995 |
| strip_assums2 (Const("Pure.all",_)$Abs(a,T,t1), |
|
1996 |
Const("Pure.all",_)$Abs(_,_,t2)) = |
|
0 | 1997 |
let val (B1,B2) = strip_assums2 (t1,t2) |
1998 |
in (Abs(a,T,B1), Abs(a,T,B2)) end |
|
1999 |
| strip_assums2 BB = BB; |
|
2000 |
||
2001 |
||
721
479832ff2d29
Pure/thm/norm_term_skip: new, for skipping normalization of the context
lcp
parents:
678
diff
changeset
|
2002 |
(*Faster normalization: skip assumptions that were lifted over*) |
479832ff2d29
Pure/thm/norm_term_skip: new, for skipping normalization of the context
lcp
parents:
678
diff
changeset
|
2003 |
fun norm_term_skip env 0 t = Envir.norm_term env t |
56245 | 2004 |
| norm_term_skip env n (Const ("Pure.all", _) $ Abs (a, T, t)) = |
32032 | 2005 |
let |
58946
3bf80312508e
proper Envir.norm_type for result of Unify.unifiers (amending 479832ff2d29 from 20 years ago);
wenzelm
parents:
58837
diff
changeset
|
2006 |
val T' = Envir.norm_type (Envir.type_env env) T |
32032 | 2007 |
(*Must instantiate types of parameters because they are flattened; |
2008 |
this could be a NEW parameter*) |
|
46217
7b19666f0e3d
renamed Term.all to Logic.all_const, in accordance to HOLogic.all_const;
wenzelm
parents:
45443
diff
changeset
|
2009 |
in Logic.all_const T' $ Abs (a, T', norm_term_skip env n t) end |
56245 | 2010 |
| norm_term_skip env n (Const ("Pure.imp", _) $ A $ B) = |
32032 | 2011 |
Logic.mk_implies (A, norm_term_skip env (n - 1) B) |
32784 | 2012 |
| norm_term_skip _ _ _ = error "norm_term_skip: too few assumptions??"; |
721
479832ff2d29
Pure/thm/norm_term_skip: new, for skipping normalization of the context
lcp
parents:
678
diff
changeset
|
2013 |
|
479832ff2d29
Pure/thm/norm_term_skip: new, for skipping normalization of the context
lcp
parents:
678
diff
changeset
|
2014 |
|
52222
0fa3b456a267
unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents:
52131
diff
changeset
|
2015 |
(*unify types of schematic variables (non-lifted case)*) |
58950
d07464875dd4
optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents:
58946
diff
changeset
|
2016 |
fun unify_var_types context (th1, th2) env = |
52222
0fa3b456a267
unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents:
52131
diff
changeset
|
2017 |
let |
58950
d07464875dd4
optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents:
58946
diff
changeset
|
2018 |
fun unify_vars (T :: Us) = fold (fn U => Pattern.unify_types context (T, U)) Us |
52222
0fa3b456a267
unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents:
52131
diff
changeset
|
2019 |
| unify_vars _ = I; |
0fa3b456a267
unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents:
52131
diff
changeset
|
2020 |
val add_vars = |
0fa3b456a267
unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents:
52131
diff
changeset
|
2021 |
full_prop_of #> |
0fa3b456a267
unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents:
52131
diff
changeset
|
2022 |
fold_aterms (fn Var v => Vartab.insert_list (op =) v | _ => I); |
0fa3b456a267
unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents:
52131
diff
changeset
|
2023 |
val vars = Vartab.empty |> add_vars th1 |> add_vars th2; |
0fa3b456a267
unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents:
52131
diff
changeset
|
2024 |
in SOME (Vartab.fold (unify_vars o #2) vars env) end |
0fa3b456a267
unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents:
52131
diff
changeset
|
2025 |
handle Pattern.Unif => NONE; |
0fa3b456a267
unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents:
52131
diff
changeset
|
2026 |
|
0 | 2027 |
(*Composition of object rule r=(A1...Am/B) with proof state s=(B1...Bn/C) |
250 | 2028 |
Unifies B with Bi, replacing subgoal i (1 <= i <= n) |
0 | 2029 |
If match then forbid instantiations in proof state |
2030 |
If lifted then shorten the dpair using strip_assums2. |
|
2031 |
If eres_flg then simultaneously proves A1 by assumption. |
|
250 | 2032 |
nsubgoal is the number of new subgoals (written m above). |
0 | 2033 |
Curried so that resolution calls dest_state only once. |
2034 |
*) |
|
4270 | 2035 |
local exception COMPOSE |
0 | 2036 |
in |
58950
d07464875dd4
optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents:
58946
diff
changeset
|
2037 |
fun bicompose_aux opt_ctxt {flatten, match, incremented} (state, (stpairs, Bs, Bi, C), lifted) |
0 | 2038 |
(eres_flg, orule, nsubgoal) = |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
2039 |
let val Thm (sder, {maxidx=smax, constraints = constraints2, shyps = shyps2, hyps = hyps2, ...}) = state |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
2040 |
and Thm (rder, {maxidx=rmax, constraints = constraints1, shyps = shyps1, hyps = hyps1, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
2041 |
tpairs=rtpairs, prop=rprop,...}) = orule |
1529 | 2042 |
(*How many hyps to skip over during normalization*) |
21576 | 2043 |
and nlift = Logic.count_prems (strip_all_body Bi) + (if eres_flg then ~1 else 0) |
64981
ea6199b23dfa
proper background certificate from make_context, which can be a super-theory of the direct join (amending d07464875dd4);
wenzelm
parents:
64574
diff
changeset
|
2044 |
val (context, cert) = |
ea6199b23dfa
proper background certificate from make_context, which can be a super-theory of the direct join (amending d07464875dd4);
wenzelm
parents:
64574
diff
changeset
|
2045 |
make_context_certificate [state, orule] opt_ctxt (join_certificate2 (state, orule)); |
67721 | 2046 |
(*Add new theorem with prop = "\<lbrakk>Bs; As\<rbrakk> \<Longrightarrow> C" to thq*) |
32032 | 2047 |
fun addth A (As, oldAs, rder', n) ((env, tpairs), thq) = |
250 | 2048 |
let val normt = Envir.norm_term env; |
2049 |
(*perform minimal copying here by examining env*) |
|
13658
c9ad3e64ddcf
Changed handling of flex-flex constraints: now stored in separate
berghofe
parents:
13642
diff
changeset
|
2050 |
val (ntpairs, normp) = |
c9ad3e64ddcf
Changed handling of flex-flex constraints: now stored in separate
berghofe
parents:
13642
diff
changeset
|
2051 |
if Envir.is_empty env then (tpairs, (Bs @ As, C)) |
250 | 2052 |
else |
59058
a78612c67ec0
renamed "pairself" to "apply2", in accordance to @{apply 2};
wenzelm
parents:
58950
diff
changeset
|
2053 |
let val ntps = map (apply2 normt) tpairs |
19861 | 2054 |
in if Envir.above env smax then |
1238 | 2055 |
(*no assignments in state; normalize the rule only*) |
2056 |
if lifted |
|
13658
c9ad3e64ddcf
Changed handling of flex-flex constraints: now stored in separate
berghofe
parents:
13642
diff
changeset
|
2057 |
then (ntps, (Bs @ map (norm_term_skip env nlift) As, C)) |
c9ad3e64ddcf
Changed handling of flex-flex constraints: now stored in separate
berghofe
parents:
13642
diff
changeset
|
2058 |
else (ntps, (Bs @ map normt As, C)) |
1529 | 2059 |
else if match then raise COMPOSE |
250 | 2060 |
else (*normalize the new rule fully*) |
13658
c9ad3e64ddcf
Changed handling of flex-flex constraints: now stored in separate
berghofe
parents:
13642
diff
changeset
|
2061 |
(ntps, (map normt (Bs @ As), normt C)) |
250 | 2062 |
end |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
2063 |
val constraints' = |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
2064 |
union_constraints constraints1 constraints2 |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
2065 |
|> insert_constraints_env (Context.certificate_theory cert) env; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
2066 |
val th = |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
2067 |
Thm (deriv_rule2 |
11518 | 2068 |
((if Envir.is_empty env then I |
19861 | 2069 |
else if Envir.above env smax then |
37309 | 2070 |
(fn f => fn der => f (Proofterm.norm_proof' env der)) |
11518 | 2071 |
else |
37309 | 2072 |
curry op oo (Proofterm.norm_proof' env)) |
2073 |
(Proofterm.bicompose_proof flatten Bs oldAs As A n (nlift+1))) rder' sder, |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
2074 |
{tags = [], |
32032 | 2075 |
maxidx = Envir.maxidx_of env, |
70459
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
2076 |
constraints = constraints', |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
2077 |
shyps = Envir.insert_sorts env (Sorts.union shyps1 shyps2), |
f0a445c5a82c
maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents:
70458
diff
changeset
|
2078 |
hyps = union_hyps hyps1 hyps2, |
13658
c9ad3e64ddcf
Changed handling of flex-flex constraints: now stored in separate
berghofe
parents:
13642
diff
changeset
|
2079 |
tpairs = ntpairs, |
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
2080 |
prop = Logic.list_implies normp, |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
2081 |
cert = cert}) |
19475 | 2082 |
in Seq.cons th thq end handle COMPOSE => thq; |
13658
c9ad3e64ddcf
Changed handling of flex-flex constraints: now stored in separate
berghofe
parents:
13642
diff
changeset
|
2083 |
val (rAs,B) = Logic.strip_prems(nsubgoal, [], rprop) |
0 | 2084 |
handle TERM _ => raise THM("bicompose: rule", 0, [orule,state]); |
2085 |
(*Modify assumptions, deleting n-th if n>0 for e-resolution*) |
|
2086 |
fun newAs(As0, n, dpairs, tpairs) = |
|
11518 | 2087 |
let val (As1, rder') = |
25939 | 2088 |
if not lifted then (As0, rder) |
44108
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
2089 |
else |
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
2090 |
let val rename = rename_bvars dpairs tpairs B As0 |
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
2091 |
in (map (rename strip_apply) As0, |
52487
48bc24467008
backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents:
52470
diff
changeset
|
2092 |
deriv_rule1 (Proofterm.map_proof_terms (rename K) I) rder) |
44108
476a239d3e0e
rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents:
43795
diff
changeset
|
2093 |
end; |
18486 | 2094 |
in (map (if flatten then (Logic.flatten_params n) else I) As1, As1, rder', n) |
250 | 2095 |
handle TERM _ => |
2096 |
raise THM("bicompose: 1st premise", 0, [orule]) |
|
0 | 2097 |
end; |
2098 |
val BBi = if lifted then strip_assums2(B,Bi) else (B,Bi); |
|
2099 |
val dpairs = BBi :: (rtpairs@stpairs); |
|
30554
73f8bd5f0af8
substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents:
30466
diff
changeset
|
2100 |
|
73f8bd5f0af8
substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents:
30466
diff
changeset
|
2101 |
(*elim-resolution: try each assumption in turn*) |
52222
0fa3b456a267
unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents:
52131
diff
changeset
|
2102 |
fun eres _ [] = raise THM ("bicompose: no premises", 0, [orule, state]) |
0fa3b456a267
unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents:
52131
diff
changeset
|
2103 |
| eres env (A1 :: As) = |
30554
73f8bd5f0af8
substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents:
30466
diff
changeset
|
2104 |
let |
73f8bd5f0af8
substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents:
30466
diff
changeset
|
2105 |
val A = SOME A1; |
30556
7be15917f3fa
eq_assumption: slightly more efficient by checking (open) result of Logic.assum_problems directly;
wenzelm
parents:
30554
diff
changeset
|
2106 |
val (close, asms, concl) = Logic.assum_problems (nlift + 1, A1); |
7be15917f3fa
eq_assumption: slightly more efficient by checking (open) result of Logic.assum_problems directly;
wenzelm
parents:
30554
diff
changeset
|
2107 |
val concl' = close concl; |
30554
73f8bd5f0af8
substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents:
30466
diff
changeset
|
2108 |
fun tryasms [] _ = Seq.empty |
30556
7be15917f3fa
eq_assumption: slightly more efficient by checking (open) result of Logic.assum_problems directly;
wenzelm
parents:
30554
diff
changeset
|
2109 |
| tryasms (asm :: rest) n = |
7be15917f3fa
eq_assumption: slightly more efficient by checking (open) result of Logic.assum_problems directly;
wenzelm
parents:
30554
diff
changeset
|
2110 |
if Term.could_unify (asm, concl) then |
7be15917f3fa
eq_assumption: slightly more efficient by checking (open) result of Logic.assum_problems directly;
wenzelm
parents:
30554
diff
changeset
|
2111 |
let val asm' = close asm in |
58950
d07464875dd4
optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents:
58946
diff
changeset
|
2112 |
(case Seq.pull (Unify.unifiers (context, env, (asm', concl') :: dpairs)) of |
30554
73f8bd5f0af8
substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents:
30466
diff
changeset
|
2113 |
NONE => tryasms rest (n + 1) |
73f8bd5f0af8
substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents:
30466
diff
changeset
|
2114 |
| cell as SOME ((_, tpairs), _) => |
30556
7be15917f3fa
eq_assumption: slightly more efficient by checking (open) result of Logic.assum_problems directly;
wenzelm
parents:
30554
diff
changeset
|
2115 |
Seq.it_right (addth A (newAs (As, n, [BBi, (concl', asm')], tpairs))) |
30554
73f8bd5f0af8
substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents:
30466
diff
changeset
|
2116 |
(Seq.make (fn () => cell), |
73f8bd5f0af8
substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents:
30466
diff
changeset
|
2117 |
Seq.make (fn () => Seq.pull (tryasms rest (n + 1))))) |
73f8bd5f0af8
substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents:
30466
diff
changeset
|
2118 |
end |
73f8bd5f0af8
substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents:
30466
diff
changeset
|
2119 |
else tryasms rest (n + 1); |
30556
7be15917f3fa
eq_assumption: slightly more efficient by checking (open) result of Logic.assum_problems directly;
wenzelm
parents:
30554
diff
changeset
|
2120 |
in tryasms asms 1 end; |
30554
73f8bd5f0af8
substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents:
30466
diff
changeset
|
2121 |
|
0 | 2122 |
(*ordinary resolution*) |
52222
0fa3b456a267
unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents:
52131
diff
changeset
|
2123 |
fun res env = |
58950
d07464875dd4
optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents:
58946
diff
changeset
|
2124 |
(case Seq.pull (Unify.unifiers (context, env, dpairs)) of |
30554
73f8bd5f0af8
substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents:
30466
diff
changeset
|
2125 |
NONE => Seq.empty |
73f8bd5f0af8
substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents:
30466
diff
changeset
|
2126 |
| cell as SOME ((_, tpairs), _) => |
73f8bd5f0af8
substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents:
30466
diff
changeset
|
2127 |
Seq.it_right (addth NONE (newAs (rev rAs, 0, [BBi], tpairs))) |
73f8bd5f0af8
substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents:
30466
diff
changeset
|
2128 |
(Seq.make (fn () => cell), Seq.empty)); |
52222
0fa3b456a267
unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents:
52131
diff
changeset
|
2129 |
|
0fa3b456a267
unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents:
52131
diff
changeset
|
2130 |
val env0 = Envir.empty (Int.max (rmax, smax)); |
30554
73f8bd5f0af8
substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents:
30466
diff
changeset
|
2131 |
in |
58950
d07464875dd4
optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents:
58946
diff
changeset
|
2132 |
(case if incremented then SOME env0 else unify_var_types context (state, orule) env0 of |
52222
0fa3b456a267
unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents:
52131
diff
changeset
|
2133 |
NONE => Seq.empty |
0fa3b456a267
unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents:
52131
diff
changeset
|
2134 |
| SOME env => if eres_flg then eres env (rev rAs) else res env) |
0 | 2135 |
end; |
7528 | 2136 |
end; |
0 | 2137 |
|
58950
d07464875dd4
optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents:
58946
diff
changeset
|
2138 |
fun bicompose opt_ctxt flags arg i state = |
d07464875dd4
optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents:
58946
diff
changeset
|
2139 |
bicompose_aux opt_ctxt flags (state, dest_state (state,i), false) arg; |
0 | 2140 |
|
2141 |
(*Quick test whether rule is resolvable with the subgoal with hyps Hs |
|
2142 |
and conclusion B. If eres_flg then checks 1st premise of rule also*) |
|
2143 |
fun could_bires (Hs, B, eres_flg, rule) = |
|
29269
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29003
diff
changeset
|
2144 |
let fun could_reshyp (A1::_) = exists (fn H => Term.could_unify (A1, H)) Hs |
250 | 2145 |
| could_reshyp [] = false; (*no premise -- illegal*) |
29269
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29003
diff
changeset
|
2146 |
in Term.could_unify(concl_of rule, B) andalso |
250 | 2147 |
(not eres_flg orelse could_reshyp (prems_of rule)) |
0 | 2148 |
end; |
2149 |
||
2150 |
(*Bi-resolution of a state with a list of (flag,rule) pairs. |
|
2151 |
Puts the rule above: rule/state. Renames vars in the rules. *) |
|
58950
d07464875dd4
optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents:
58946
diff
changeset
|
2152 |
fun biresolution opt_ctxt match brules i state = |
18035 | 2153 |
let val (stpairs, Bs, Bi, C) = dest_state(state,i); |
18145 | 2154 |
val lift = lift_rule (cprem_of state i); |
250 | 2155 |
val B = Logic.strip_assums_concl Bi; |
2156 |
val Hs = Logic.strip_assums_hyp Bi; |
|
52223
5bb6ae8acb87
tuned signature -- more explicit flags for low-level Thm.bicompose;
wenzelm
parents:
52222
diff
changeset
|
2157 |
val compose = |
58950
d07464875dd4
optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents:
58946
diff
changeset
|
2158 |
bicompose_aux opt_ctxt {flatten = true, match = match, incremented = true} |
52223
5bb6ae8acb87
tuned signature -- more explicit flags for low-level Thm.bicompose;
wenzelm
parents:
52222
diff
changeset
|
2159 |
(state, (stpairs, Bs, Bi, C), true); |
4270 | 2160 |
fun res [] = Seq.empty |
250 | 2161 |
| res ((eres_flg, rule)::brules) = |
61044
b7af255dd200
more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents:
61042
diff
changeset
|
2162 |
if Config.get_generic (make_context [state] opt_ctxt (cert_of state)) |
58950
d07464875dd4
optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents:
58946
diff
changeset
|
2163 |
Pattern.unify_trace_failure orelse could_bires (Hs, B, eres_flg, rule) |
4270 | 2164 |
then Seq.make (*delay processing remainder till needed*) |
22573 | 2165 |
(fn()=> SOME(compose (eres_flg, lift rule, nprems_of rule), |
250 | 2166 |
res brules)) |
2167 |
else res brules |
|
4270 | 2168 |
in Seq.flat (res brules) end; |
0 | 2169 |
|
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2170 |
(*Resolution: exactly one resolvent must be produced*) |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2171 |
fun tha RSN (i, thb) = |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2172 |
(case Seq.chop 2 (biresolution NONE false [(false, tha)] i thb) of |
70472
cf66d2db97fe
more robust and convenient treatment of implicit context;
wenzelm
parents:
70469
diff
changeset
|
2173 |
([th], _) => solve_constraints th |
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2174 |
| ([], _) => raise THM ("RSN: no unifiers", i, [tha, thb]) |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2175 |
| _ => raise THM ("RSN: multiple unifiers", i, [tha, thb])); |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2176 |
|
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2177 |
(*Resolution: P \<Longrightarrow> Q, Q \<Longrightarrow> R gives P \<Longrightarrow> R*) |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2178 |
fun tha RS thb = tha RSN (1,thb); |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2179 |
|
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2180 |
|
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2181 |
|
70458 | 2182 |
(**** Type classes ****) |
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2183 |
|
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2184 |
fun standard_tvars thm = |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2185 |
let |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2186 |
val thy = theory_of_thm thm; |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2187 |
val tvars = rev (Term.add_tvars (prop_of thm) []); |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2188 |
val names = Name.invent Name.context Name.aT (length tvars); |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2189 |
val tinst = |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2190 |
map2 (fn (ai, S) => fn b => ((ai, S), global_ctyp_of thy (TVar ((b, 0), S)))) tvars names; |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2191 |
in instantiate (tinst, []) thm end |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2192 |
|
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2193 |
|
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2194 |
(* class relations *) |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2195 |
|
70457 | 2196 |
val is_classrel = Symreltab.defined o get_classrels; |
2197 |
||
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2198 |
fun complete_classrels thy = |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2199 |
let |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2200 |
fun complete (c, (_, (all_preds, all_succs))) (finished1, thy1) = |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2201 |
let |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2202 |
fun compl c1 c2 (finished2, thy2) = |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2203 |
if is_classrel thy2 (c1, c2) then (finished2, thy2) |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2204 |
else |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2205 |
(false, |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2206 |
thy2 |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2207 |
|> (map_classrels o Symreltab.update) ((c1, c2), |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2208 |
(the_classrel thy2 (c1, c) RS the_classrel thy2 (c, c2)) |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2209 |
|> standard_tvars |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2210 |
|> close_derivation |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2211 |
|> trim_context)); |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2212 |
|
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2213 |
val proven = is_classrel thy1; |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2214 |
val preds = Graph.Keys.fold (fn c1 => proven (c1, c) ? cons c1) all_preds []; |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2215 |
val succs = Graph.Keys.fold (fn c2 => proven (c, c2) ? cons c2) all_succs []; |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2216 |
in |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2217 |
fold_product compl preds succs (finished1, thy1) |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2218 |
end; |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2219 |
in |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2220 |
(case Graph.fold complete (Sorts.classes_of (Sign.classes_of thy)) (true, thy) of |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2221 |
(true, _) => NONE |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2222 |
| (_, thy') => SOME thy') |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2223 |
end; |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2224 |
|
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2225 |
|
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2226 |
(* type arities *) |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2227 |
|
70475
98b6da301e13
backed out changeset 1b8858f4c393: odd problems e.g. in CAVA_LTL_Modelchecker;
wenzelm
parents:
70472
diff
changeset
|
2228 |
fun thynames_of_arity thy (a, c) = |
98b6da301e13
backed out changeset 1b8858f4c393: odd problems e.g. in CAVA_LTL_Modelchecker;
wenzelm
parents:
70472
diff
changeset
|
2229 |
(get_arities thy, []) |-> Aritytab.fold |
98b6da301e13
backed out changeset 1b8858f4c393: odd problems e.g. in CAVA_LTL_Modelchecker;
wenzelm
parents:
70472
diff
changeset
|
2230 |
(fn ((a', _, c'), (_, name, ser)) => (a = a' andalso c = c') ? cons (name, ser)) |
98b6da301e13
backed out changeset 1b8858f4c393: odd problems e.g. in CAVA_LTL_Modelchecker;
wenzelm
parents:
70472
diff
changeset
|
2231 |
|> sort (int_ord o apply2 #2) |> map #1; |
98b6da301e13
backed out changeset 1b8858f4c393: odd problems e.g. in CAVA_LTL_Modelchecker;
wenzelm
parents:
70472
diff
changeset
|
2232 |
|
98b6da301e13
backed out changeset 1b8858f4c393: odd problems e.g. in CAVA_LTL_Modelchecker;
wenzelm
parents:
70472
diff
changeset
|
2233 |
fun insert_arity_completions thy ((t, Ss, c), (th, thy_name, ser)) (finished, arities) = |
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2234 |
let |
70461 | 2235 |
val completions = |
2236 |
Sign.super_classes thy c |> map_filter (fn c1 => |
|
70465 | 2237 |
if Aritytab.defined arities (t, Ss, c1) then NONE |
70461 | 2238 |
else |
2239 |
let |
|
2240 |
val th1 = |
|
2241 |
(th RS the_classrel thy (c, c1)) |
|
2242 |
|> standard_tvars |
|
2243 |
|> close_derivation |
|
2244 |
|> trim_context; |
|
70475
98b6da301e13
backed out changeset 1b8858f4c393: odd problems e.g. in CAVA_LTL_Modelchecker;
wenzelm
parents:
70472
diff
changeset
|
2245 |
in SOME ((t, Ss, c1), (th1, thy_name, ser)) end); |
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2246 |
val finished' = finished andalso null completions; |
70465 | 2247 |
val arities' = fold Aritytab.update completions arities; |
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2248 |
in (finished', arities') end; |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2249 |
|
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2250 |
fun complete_arities thy = |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2251 |
let |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2252 |
val arities = get_arities thy; |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2253 |
val (finished, arities') = |
70465 | 2254 |
Aritytab.fold (insert_arity_completions thy) arities (true, get_arities thy); |
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2255 |
in |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2256 |
if finished then NONE |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2257 |
else SOME (map_arities (K arities') thy) |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2258 |
end; |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2259 |
|
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2260 |
val _ = |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2261 |
Theory.setup |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2262 |
(Theory.at_begin complete_classrels #> |
70458 | 2263 |
Theory.at_begin complete_arities); |
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2264 |
|
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2265 |
|
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2266 |
(* primitive rules *) |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2267 |
|
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2268 |
fun add_classrel raw_th thy = |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2269 |
let |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2270 |
val th = strip_shyps (transfer thy raw_th); |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2271 |
val prop = plain_prop_of th; |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2272 |
val (c1, c2) = Logic.dest_classrel prop; |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2273 |
in |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2274 |
thy |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2275 |
|> Sign.primitive_classrel (c1, c2) |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2276 |
|> map_classrels (Symreltab.update ((c1, c2), th |> unconstrainT |> trim_context)) |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2277 |
|> perhaps complete_classrels |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2278 |
|> perhaps complete_arities |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2279 |
end; |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2280 |
|
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2281 |
fun add_arity raw_th thy = |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2282 |
let |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2283 |
val th = strip_shyps (transfer thy raw_th); |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2284 |
val prop = plain_prop_of th; |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2285 |
val (t, Ss, c) = Logic.dest_arity prop; |
70475
98b6da301e13
backed out changeset 1b8858f4c393: odd problems e.g. in CAVA_LTL_Modelchecker;
wenzelm
parents:
70472
diff
changeset
|
2286 |
val ar = ((t, Ss, c), (th |> unconstrainT |> trim_context, Context.theory_name thy, serial ())); |
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2287 |
in |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2288 |
thy |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2289 |
|> Sign.primitive_arity (t, Ss, [c]) |
70465 | 2290 |
|> map_arities (Aritytab.update ar #> curry (insert_arity_completions thy ar) true #> #2) |
70456
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2291 |
end; |
c742527a25fe
clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents:
70454
diff
changeset
|
2292 |
|
0 | 2293 |
end; |
1503 | 2294 |
|
32104 | 2295 |
structure Basic_Thm: BASIC_THM = Thm; |
2296 |
open Basic_Thm; |