author | wenzelm |
Fri, 17 Jul 2009 23:11:40 +0200 | |
changeset 32035 | 8e77b6a250d5 |
parent 32032 | a6a6e8031c14 |
child 32059 | 7991cdf10a54 |
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, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
6 |
derivations, theorems, framework rules (including lifting and |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
7 |
resolution), oracles. |
0 | 8 |
*) |
9 |
||
6089 | 10 |
signature BASIC_THM = |
1503 | 11 |
sig |
1160 | 12 |
(*certified types*) |
387
69f4356d915d
new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents:
309
diff
changeset
|
13 |
type ctyp |
16656 | 14 |
val rep_ctyp: ctyp -> |
26631
d6b6c74a8bcf
rep_cterm/rep_thm: no longer dereference theory_ref;
wenzelm
parents:
26424
diff
changeset
|
15 |
{thy_ref: theory_ref, |
16656 | 16 |
T: typ, |
20512 | 17 |
maxidx: int, |
28354 | 18 |
sorts: sort OrdList.T} |
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
19 |
val theory_of_ctyp: ctyp -> theory |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
20 |
val typ_of: ctyp -> typ |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
21 |
val ctyp_of: theory -> typ -> ctyp |
1160 | 22 |
|
23 |
(*certified terms*) |
|
24 |
type cterm |
|
22584 | 25 |
exception CTERM of string * cterm list |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
26 |
val rep_cterm: cterm -> |
26631
d6b6c74a8bcf
rep_cterm/rep_thm: no longer dereference theory_ref;
wenzelm
parents:
26424
diff
changeset
|
27 |
{thy_ref: theory_ref, |
16656 | 28 |
t: term, |
29 |
T: typ, |
|
30 |
maxidx: int, |
|
28354 | 31 |
sorts: sort OrdList.T} |
32 |
val crep_cterm: cterm -> |
|
33 |
{thy_ref: theory_ref, t: term, T: ctyp, maxidx: int, sorts: sort OrdList.T} |
|
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
34 |
val theory_of_cterm: cterm -> theory |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
35 |
val term_of: cterm -> term |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
36 |
val cterm_of: theory -> term -> cterm |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
37 |
val ctyp_of_term: cterm -> ctyp |
1160 | 38 |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
39 |
(*theorems*) |
1160 | 40 |
type thm |
23601 | 41 |
type conv = cterm -> thm |
42 |
type attribute = Context.generic * thm -> Context.generic * thm |
|
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
43 |
val rep_thm: thm -> |
26631
d6b6c74a8bcf
rep_cterm/rep_thm: no longer dereference theory_ref;
wenzelm
parents:
26424
diff
changeset
|
44 |
{thy_ref: theory_ref, |
28017 | 45 |
tags: Properties.T, |
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
46 |
maxidx: int, |
28354 | 47 |
shyps: sort OrdList.T, |
48 |
hyps: term OrdList.T, |
|
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
49 |
tpairs: (term * term) list, |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
50 |
prop: term} |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
51 |
val crep_thm: thm -> |
26631
d6b6c74a8bcf
rep_cterm/rep_thm: no longer dereference theory_ref;
wenzelm
parents:
26424
diff
changeset
|
52 |
{thy_ref: theory_ref, |
28017 | 53 |
tags: Properties.T, |
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
54 |
maxidx: int, |
28354 | 55 |
shyps: sort OrdList.T, |
56 |
hyps: cterm OrdList.T, |
|
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
57 |
tpairs: (cterm * cterm) list, |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
58 |
prop: cterm} |
6089 | 59 |
exception THM of string * int * thm list |
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
60 |
val theory_of_thm: thm -> theory |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
61 |
val prop_of: thm -> term |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
62 |
val tpairs_of: thm -> (term * term) list |
16656 | 63 |
val concl_of: thm -> term |
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
64 |
val prems_of: thm -> term list |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
65 |
val nprems_of: thm -> int |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
66 |
val cprop_of: thm -> cterm |
18145 | 67 |
val cprem_of: thm -> int -> cterm |
16656 | 68 |
val transfer: theory -> thm -> thm |
16945 | 69 |
val weaken: cterm -> thm -> thm |
28624 | 70 |
val weaken_sorts: sort list -> cterm -> cterm |
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
71 |
val extra_shyps: thm -> sort list |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
72 |
val strip_shyps: thm -> thm |
1160 | 73 |
|
74 |
(*meta rules*) |
|
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
75 |
val assume: cterm -> thm |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
76 |
val implies_intr: cterm -> thm -> thm |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
77 |
val implies_elim: thm -> thm -> thm |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
78 |
val forall_intr: cterm -> thm -> thm |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
79 |
val forall_elim: cterm -> thm -> thm |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
80 |
val reflexive: cterm -> thm |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
81 |
val symmetric: thm -> thm |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
82 |
val transitive: thm -> thm -> thm |
23601 | 83 |
val beta_conversion: bool -> conv |
84 |
val eta_conversion: conv |
|
85 |
val eta_long_conversion: conv |
|
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
86 |
val abstract_rule: string -> cterm -> thm -> thm |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
87 |
val combination: thm -> thm -> thm |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
88 |
val equal_intr: thm -> thm -> thm |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
89 |
val equal_elim: thm -> thm -> thm |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
90 |
val flexflex_rule: thm -> thm Seq.seq |
19910 | 91 |
val generalize: string list * string list -> int -> thm -> thm |
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
92 |
val instantiate: (ctyp * ctyp) list * (cterm * cterm) list -> thm -> thm |
22584 | 93 |
val instantiate_cterm: (ctyp * ctyp) list * (cterm * cterm) list -> cterm -> cterm |
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
94 |
val trivial: cterm -> thm |
31944 | 95 |
val of_class: ctyp * class -> thm |
19505 | 96 |
val unconstrainT: ctyp -> thm -> thm |
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
97 |
val dest_state: thm * int -> (term * term) list * term list * term * term |
18035 | 98 |
val lift_rule: cterm -> thm -> thm |
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
99 |
val incr_indexes: int -> thm -> thm |
250 | 100 |
end; |
0 | 101 |
|
6089 | 102 |
signature THM = |
103 |
sig |
|
104 |
include BASIC_THM |
|
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
105 |
val dest_ctyp: ctyp -> ctyp list |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
106 |
val dest_comb: cterm -> cterm * cterm |
22909 | 107 |
val dest_fun: cterm -> cterm |
20580
6fb75df09253
added dest_arg, i.e. a tuned version of #2 o dest_comb;
wenzelm
parents:
20548
diff
changeset
|
108 |
val dest_arg: cterm -> cterm |
22909 | 109 |
val dest_fun2: cterm -> cterm |
110 |
val dest_arg1: cterm -> cterm |
|
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
111 |
val dest_abs: string option -> cterm -> cterm * cterm |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
112 |
val capply: cterm -> cterm -> cterm |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
113 |
val cabs: cterm -> cterm -> cterm |
31945 | 114 |
val adjust_maxidx_cterm: int -> cterm -> cterm |
115 |
val incr_indexes_cterm: int -> cterm -> cterm |
|
116 |
val match: cterm * cterm -> (ctyp * ctyp) list * (cterm * cterm) list |
|
117 |
val first_order_match: cterm * cterm -> (ctyp * ctyp) list * (cterm * cterm) list |
|
31947
7daee3bed3af
clarified strip_shyps: proper type witnesses for present sorts;
wenzelm
parents:
31945
diff
changeset
|
118 |
val fold_terms: (term -> 'a -> 'a) -> thm -> 'a -> 'a |
16945 | 119 |
val terms_of_tpairs: (term * term) list -> term list |
31945 | 120 |
val full_prop_of: thm -> term |
19881 | 121 |
val maxidx_of: thm -> int |
19910 | 122 |
val maxidx_thm: thm -> int -> int |
19881 | 123 |
val hyps_of: thm -> term list |
31945 | 124 |
val no_prems: thm -> bool |
125 |
val major_prem_of: thm -> term |
|
28675
fb68c0767004
renamed get_axiom_i to axiom, removed obsolete get_axiom;
wenzelm
parents:
28648
diff
changeset
|
126 |
val axiom: theory -> string -> thm |
fb68c0767004
renamed get_axiom_i to axiom, removed obsolete get_axiom;
wenzelm
parents:
28648
diff
changeset
|
127 |
val axioms_of: theory -> (string * thm) list |
28017 | 128 |
val get_tags: thm -> Properties.T |
129 |
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
|
130 |
val norm_proof: thm -> thm |
20261 | 131 |
val adjust_maxidx_thm: int -> thm -> thm |
20002 | 132 |
val varifyT: thm -> thm |
133 |
val varifyT': (string * sort) list -> thm -> ((string * sort) * indexname) list * thm |
|
19881 | 134 |
val freezeT: thm -> thm |
31945 | 135 |
val assumption: int -> thm -> thm Seq.seq |
136 |
val eq_assumption: int -> thm -> thm |
|
137 |
val rotate_rule: int -> int -> thm -> thm |
|
138 |
val permute_prems: int -> int -> thm -> thm |
|
139 |
val rename_params_rule: string list * int -> thm -> thm |
|
140 |
val compose_no_flatten: bool -> thm * int -> int -> thm -> thm Seq.seq |
|
141 |
val bicompose: bool -> bool * thm * int -> int -> thm -> thm Seq.seq |
|
142 |
val biresolution: bool -> (bool * thm) list -> int -> thm -> thm Seq.seq |
|
143 |
val rename_boundvars: term -> term -> thm -> thm |
|
28978
f3e37d78b4f7
future proofs: pass actual futures to facilitate composite computations;
wenzelm
parents:
28874
diff
changeset
|
144 |
val future: thm future -> cterm -> thm |
29432
5bb5551bef03
added pending_groups -- accumulates task groups of local derivations only;
wenzelm
parents:
29288
diff
changeset
|
145 |
val pending_groups: thm -> Task_Queue.group list -> Task_Queue.group list |
30713
b1a87e3971a3
status_of: need to include local promises as well!
wenzelm
parents:
30711
diff
changeset
|
146 |
val status_of: thm -> {oracle: bool, unfinished: bool, failed: bool} |
28814 | 147 |
val proof_body_of: thm -> proof_body |
148 |
val proof_of: thm -> proof |
|
29003 | 149 |
val join_proof: thm -> unit |
31945 | 150 |
val get_name: thm -> string |
151 |
val put_name: string -> thm -> thm |
|
28330 | 152 |
val extern_oracles: theory -> xstring list |
30288
a32700e45ab3
Thm.add_oracle interface: replaced old bstring by binding;
wenzelm
parents:
29636
diff
changeset
|
153 |
val add_oracle: binding * ('a -> cterm) -> theory -> (string * ('a -> thm)) * theory |
6089 | 154 |
end; |
155 |
||
28356
ac4498f95d1c
abtract types: plain datatype with opaque signature matching;
wenzelm
parents:
28354
diff
changeset
|
156 |
structure Thm:> THM = |
0 | 157 |
struct |
250 | 158 |
|
22237
bb9b1c8a8a95
old-fashioned abstype ctyp/cterm/thm prevents accidental equality tests;
wenzelm
parents:
21975
diff
changeset
|
159 |
structure Pt = Proofterm; |
bb9b1c8a8a95
old-fashioned abstype ctyp/cterm/thm prevents accidental equality tests;
wenzelm
parents:
21975
diff
changeset
|
160 |
|
16656 | 161 |
|
387
69f4356d915d
new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents:
309
diff
changeset
|
162 |
(*** Certified terms and types ***) |
69f4356d915d
new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents:
309
diff
changeset
|
163 |
|
250 | 164 |
(** certified types **) |
165 |
||
28356
ac4498f95d1c
abtract types: plain datatype with opaque signature matching;
wenzelm
parents:
28354
diff
changeset
|
166 |
datatype ctyp = Ctyp of |
20512 | 167 |
{thy_ref: theory_ref, |
168 |
T: typ, |
|
169 |
maxidx: int, |
|
28356
ac4498f95d1c
abtract types: plain datatype with opaque signature matching;
wenzelm
parents:
28354
diff
changeset
|
170 |
sorts: sort OrdList.T}; |
250 | 171 |
|
26631
d6b6c74a8bcf
rep_cterm/rep_thm: no longer dereference theory_ref;
wenzelm
parents:
26424
diff
changeset
|
172 |
fun rep_ctyp (Ctyp args) = args; |
16656 | 173 |
fun theory_of_ctyp (Ctyp {thy_ref, ...}) = Theory.deref thy_ref; |
250 | 174 |
fun typ_of (Ctyp {T, ...}) = T; |
175 |
||
16656 | 176 |
fun 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
|
177 |
let |
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
178 |
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
|
179 |
val maxidx = Term.maxidx_of_typ T; |
26640
92e6d3ec91bd
simplified handling of sorts, removed unnecessary universal witness;
wenzelm
parents:
26631
diff
changeset
|
180 |
val sorts = Sorts.insert_typ T []; |
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
181 |
in Ctyp {thy_ref = Theory.check_thy thy, T = T, maxidx = maxidx, sorts = sorts} end; |
250 | 182 |
|
20512 | 183 |
fun dest_ctyp (Ctyp {thy_ref, T = Type (s, Ts), maxidx, sorts}) = |
184 |
map (fn T => Ctyp {thy_ref = thy_ref, T = T, maxidx = maxidx, sorts = sorts}) Ts |
|
16679 | 185 |
| dest_ctyp cT = raise TYPE ("dest_ctyp", [typ_of cT], []); |
15087 | 186 |
|
229
4002c4cd450c
Pure: MAJOR CHANGE. Moved ML types ctyp and cterm and their associated
lcp
parents:
225
diff
changeset
|
187 |
|
4002c4cd450c
Pure: MAJOR CHANGE. Moved ML types ctyp and cterm and their associated
lcp
parents:
225
diff
changeset
|
188 |
|
250 | 189 |
(** certified terms **) |
229
4002c4cd450c
Pure: MAJOR CHANGE. Moved ML types ctyp and cterm and their associated
lcp
parents:
225
diff
changeset
|
190 |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
191 |
(*certified terms with checked typ, maxidx, and sorts*) |
28356
ac4498f95d1c
abtract types: plain datatype with opaque signature matching;
wenzelm
parents:
28354
diff
changeset
|
192 |
datatype cterm = Cterm of |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
193 |
{thy_ref: theory_ref, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
194 |
t: term, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
195 |
T: typ, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
196 |
maxidx: int, |
28356
ac4498f95d1c
abtract types: plain datatype with opaque signature matching;
wenzelm
parents:
28354
diff
changeset
|
197 |
sorts: sort OrdList.T}; |
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
198 |
|
22584 | 199 |
exception CTERM of string * cterm list; |
16679 | 200 |
|
26631
d6b6c74a8bcf
rep_cterm/rep_thm: no longer dereference theory_ref;
wenzelm
parents:
26424
diff
changeset
|
201 |
fun rep_cterm (Cterm args) = args; |
229
4002c4cd450c
Pure: MAJOR CHANGE. Moved ML types ctyp and cterm and their associated
lcp
parents:
225
diff
changeset
|
202 |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
203 |
fun crep_cterm (Cterm {thy_ref, t, T, maxidx, sorts}) = |
26631
d6b6c74a8bcf
rep_cterm/rep_thm: no longer dereference theory_ref;
wenzelm
parents:
26424
diff
changeset
|
204 |
{thy_ref = thy_ref, t = t, maxidx = maxidx, sorts = sorts, |
d6b6c74a8bcf
rep_cterm/rep_thm: no longer dereference theory_ref;
wenzelm
parents:
26424
diff
changeset
|
205 |
T = Ctyp {thy_ref = thy_ref, T = T, maxidx = maxidx, sorts = sorts}}; |
3967
edd5ff9371f8
sg_ref: automatic adjustment of thms of draft theories;
wenzelm
parents:
3895
diff
changeset
|
206 |
|
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
207 |
fun theory_of_cterm (Cterm {thy_ref, ...}) = Theory.deref thy_ref; |
250 | 208 |
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
|
209 |
|
20512 | 210 |
fun ctyp_of_term (Cterm {thy_ref, T, maxidx, sorts, ...}) = |
211 |
Ctyp {thy_ref = thy_ref, T = T, maxidx = maxidx, sorts = sorts}; |
|
2671 | 212 |
|
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
213 |
fun cterm_of thy tm = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
214 |
let |
18969 | 215 |
val (t, T, maxidx) = Sign.certify_term thy tm; |
26640
92e6d3ec91bd
simplified handling of sorts, removed unnecessary universal witness;
wenzelm
parents:
26631
diff
changeset
|
216 |
val sorts = Sorts.insert_term t []; |
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
217 |
in Cterm {thy_ref = Theory.check_thy 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
|
218 |
|
20057 | 219 |
fun merge_thys0 (Cterm {thy_ref = r1, t = t1, ...}) (Cterm {thy_ref = r2, t = t2, ...}) = |
23601 | 220 |
Theory.merge_refs (r1, r2); |
16656 | 221 |
|
20580
6fb75df09253
added dest_arg, i.e. a tuned version of #2 o dest_comb;
wenzelm
parents:
20548
diff
changeset
|
222 |
|
22909 | 223 |
(* destructors *) |
224 |
||
225 |
fun dest_comb (ct as Cterm {t = c $ a, T, thy_ref, maxidx, sorts}) = |
|
226 |
let val A = Term.argument_type_of c 0 in |
|
227 |
(Cterm {t = c, T = A --> T, thy_ref = thy_ref, maxidx = maxidx, sorts = sorts}, |
|
228 |
Cterm {t = a, T = A, thy_ref = thy_ref, maxidx = maxidx, sorts = sorts}) |
|
1493
e936723cb94d
added dest_comb, dest_abs and mk_prop for manipulating cterms
clasohm
parents:
1460
diff
changeset
|
229 |
end |
22584 | 230 |
| 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
|
231 |
|
22909 | 232 |
fun dest_fun (ct as Cterm {t = c $ _, T, thy_ref, maxidx, sorts}) = |
233 |
let val A = Term.argument_type_of c 0 |
|
234 |
in Cterm {t = c, T = A --> T, thy_ref = thy_ref, maxidx = maxidx, sorts = sorts} end |
|
235 |
| dest_fun ct = raise CTERM ("dest_fun", [ct]); |
|
236 |
||
237 |
fun dest_arg (ct as Cterm {t = c $ a, T = _, thy_ref, maxidx, sorts}) = |
|
238 |
let val A = Term.argument_type_of c 0 |
|
239 |
in Cterm {t = a, T = A, thy_ref = thy_ref, maxidx = maxidx, sorts = sorts} end |
|
22584 | 240 |
| 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
|
241 |
|
22909 | 242 |
|
243 |
fun dest_fun2 (Cterm {t = c $ a $ b, T, thy_ref, maxidx, sorts}) = |
|
244 |
let |
|
245 |
val A = Term.argument_type_of c 0; |
|
246 |
val B = Term.argument_type_of c 1; |
|
247 |
in Cterm {t = c, T = A --> B --> T, thy_ref = thy_ref, maxidx = maxidx, sorts = sorts} end |
|
248 |
| dest_fun2 ct = raise CTERM ("dest_fun2", [ct]); |
|
249 |
||
250 |
fun dest_arg1 (Cterm {t = c $ a $ _, T = _, thy_ref, maxidx, sorts}) = |
|
251 |
let val A = Term.argument_type_of c 0 |
|
252 |
in Cterm {t = a, T = A, thy_ref = thy_ref, maxidx = maxidx, sorts = sorts} end |
|
253 |
| dest_arg1 ct = raise CTERM ("dest_arg1", [ct]); |
|
20673 | 254 |
|
22584 | 255 |
fun dest_abs a (ct as |
256 |
Cterm {t = Abs (x, T, t), T = Type ("fun", [_, U]), thy_ref, maxidx, sorts}) = |
|
18944 | 257 |
let val (y', t') = Term.dest_abs (the_default x a, T, t) in |
16679 | 258 |
(Cterm {t = Free (y', T), T = T, thy_ref = thy_ref, maxidx = maxidx, sorts = sorts}, |
259 |
Cterm {t = t', T = U, thy_ref = thy_ref, maxidx = maxidx, sorts = sorts}) |
|
1493
e936723cb94d
added dest_comb, dest_abs and mk_prop for manipulating cterms
clasohm
parents:
1460
diff
changeset
|
260 |
end |
22584 | 261 |
| 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
|
262 |
|
22909 | 263 |
|
264 |
(* constructors *) |
|
265 |
||
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
266 |
fun capply |
16656 | 267 |
(cf as Cterm {t = f, T = Type ("fun", [dty, rty]), maxidx = maxidx1, sorts = sorts1, ...}) |
268 |
(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
|
269 |
if T = dty then |
16656 | 270 |
Cterm {thy_ref = merge_thys0 cf cx, |
271 |
t = f $ x, |
|
272 |
T = rty, |
|
273 |
maxidx = Int.max (maxidx1, maxidx2), |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
274 |
sorts = Sorts.union sorts1 sorts2} |
22584 | 275 |
else raise CTERM ("capply: types don't agree", [cf, cx]) |
276 |
| capply cf cx = raise CTERM ("capply: first arg is not a function", [cf, cx]); |
|
250 | 277 |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
278 |
fun cabs |
16656 | 279 |
(ct1 as Cterm {t = t1, T = T1, maxidx = maxidx1, sorts = sorts1, ...}) |
280 |
(ct2 as Cterm {t = t2, T = T2, maxidx = maxidx2, sorts = sorts2, ...}) = |
|
21975
1152dc45d591
Term.lambda: abstract over arbitrary closed terms;
wenzelm
parents:
21798
diff
changeset
|
281 |
let val t = Term.lambda t1 t2 in |
16656 | 282 |
Cterm {thy_ref = merge_thys0 ct1 ct2, |
283 |
t = t, T = T1 --> T2, |
|
284 |
maxidx = Int.max (maxidx1, maxidx2), |
|
285 |
sorts = Sorts.union sorts1 sorts2} |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
286 |
end; |
229
4002c4cd450c
Pure: MAJOR CHANGE. Moved ML types ctyp and cterm and their associated
lcp
parents:
225
diff
changeset
|
287 |
|
20580
6fb75df09253
added dest_arg, i.e. a tuned version of #2 o dest_comb;
wenzelm
parents:
20548
diff
changeset
|
288 |
|
22909 | 289 |
(* indexes *) |
290 |
||
20580
6fb75df09253
added dest_arg, i.e. a tuned version of #2 o dest_comb;
wenzelm
parents:
20548
diff
changeset
|
291 |
fun adjust_maxidx_cterm i (ct as Cterm {thy_ref, t, T, maxidx, sorts}) = |
6fb75df09253
added dest_arg, i.e. a tuned version of #2 o dest_comb;
wenzelm
parents:
20548
diff
changeset
|
292 |
if maxidx = i then ct |
6fb75df09253
added dest_arg, i.e. a tuned version of #2 o dest_comb;
wenzelm
parents:
20548
diff
changeset
|
293 |
else if maxidx < i then |
6fb75df09253
added dest_arg, i.e. a tuned version of #2 o dest_comb;
wenzelm
parents:
20548
diff
changeset
|
294 |
Cterm {maxidx = i, thy_ref = thy_ref, t = t, T = T, sorts = sorts} |
6fb75df09253
added dest_arg, i.e. a tuned version of #2 o dest_comb;
wenzelm
parents:
20548
diff
changeset
|
295 |
else |
6fb75df09253
added dest_arg, i.e. a tuned version of #2 o dest_comb;
wenzelm
parents:
20548
diff
changeset
|
296 |
Cterm {maxidx = Int.max (maxidx_of_term t, i), thy_ref = thy_ref, t = t, T = T, sorts = sorts}; |
6fb75df09253
added dest_arg, i.e. a tuned version of #2 o dest_comb;
wenzelm
parents:
20548
diff
changeset
|
297 |
|
22909 | 298 |
fun incr_indexes_cterm i (ct as Cterm {thy_ref, t, T, maxidx, sorts}) = |
299 |
if i < 0 then raise CTERM ("negative increment", [ct]) |
|
300 |
else if i = 0 then ct |
|
301 |
else Cterm {thy_ref = thy_ref, t = Logic.incr_indexes ([], i) t, |
|
302 |
T = Logic.incr_tvar i T, maxidx = maxidx + i, sorts = sorts}; |
|
303 |
||
304 |
||
305 |
(* matching *) |
|
306 |
||
307 |
local |
|
308 |
||
309 |
fun gen_match match |
|
20512 | 310 |
(ct1 as Cterm {t = t1, sorts = sorts1, ...}, |
20815 | 311 |
ct2 as Cterm {t = t2, sorts = sorts2, maxidx = maxidx2, ...}) = |
10416
5b33e732e459
- Moved rewriting functions to meta_simplifier.ML
berghofe
parents:
10348
diff
changeset
|
312 |
let |
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
313 |
val thy = Theory.deref (merge_thys0 ct1 ct2); |
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
314 |
val (Tinsts, tinsts) = match thy (t1, t2) (Vartab.empty, Vartab.empty); |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
315 |
val sorts = Sorts.union sorts1 sorts2; |
20512 | 316 |
fun mk_cTinst ((a, i), (S, T)) = |
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
317 |
(Ctyp {T = TVar ((a, i), S), thy_ref = Theory.check_thy thy, maxidx = i, sorts = sorts}, |
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
318 |
Ctyp {T = T, thy_ref = Theory.check_thy thy, maxidx = maxidx2, sorts = sorts}); |
20512 | 319 |
fun mk_ctinst ((x, i), (T, t)) = |
32035 | 320 |
let val T = Envir.subst_type Tinsts T in |
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
321 |
(Cterm {t = Var ((x, i), T), T = T, thy_ref = Theory.check_thy thy, |
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
322 |
maxidx = i, sorts = sorts}, |
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
323 |
Cterm {t = t, T = T, thy_ref = Theory.check_thy thy, maxidx = maxidx2, sorts = sorts}) |
10416
5b33e732e459
- Moved rewriting functions to meta_simplifier.ML
berghofe
parents:
10348
diff
changeset
|
324 |
end; |
16656 | 325 |
in (Vartab.fold (cons o mk_cTinst) Tinsts [], Vartab.fold (cons o mk_ctinst) tinsts []) end; |
10416
5b33e732e459
- Moved rewriting functions to meta_simplifier.ML
berghofe
parents:
10348
diff
changeset
|
326 |
|
22909 | 327 |
in |
10416
5b33e732e459
- Moved rewriting functions to meta_simplifier.ML
berghofe
parents:
10348
diff
changeset
|
328 |
|
22909 | 329 |
val match = gen_match Pattern.match; |
330 |
val first_order_match = gen_match Pattern.first_order_match; |
|
331 |
||
332 |
end; |
|
10416
5b33e732e459
- Moved rewriting functions to meta_simplifier.ML
berghofe
parents:
10348
diff
changeset
|
333 |
|
2509 | 334 |
|
335 |
||
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
336 |
(*** Derivations and Theorems ***) |
229
4002c4cd450c
Pure: MAJOR CHANGE. Moved ML types ctyp and cterm and their associated
lcp
parents:
225
diff
changeset
|
337 |
|
28356
ac4498f95d1c
abtract types: plain datatype with opaque signature matching;
wenzelm
parents:
28354
diff
changeset
|
338 |
datatype thm = Thm of |
28378
60cc0359363d
promise: include check into future body, i.e. joined results are always valid;
wenzelm
parents:
28364
diff
changeset
|
339 |
deriv * (*derivation*) |
60cc0359363d
promise: include check into future body, i.e. joined results are always valid;
wenzelm
parents:
28364
diff
changeset
|
340 |
{thy_ref: theory_ref, (*dynamic reference to theory*) |
60cc0359363d
promise: include check into future body, i.e. joined results are always valid;
wenzelm
parents:
28364
diff
changeset
|
341 |
tags: Properties.T, (*additional annotations/comments*) |
60cc0359363d
promise: include check into future body, i.e. joined results are always valid;
wenzelm
parents:
28364
diff
changeset
|
342 |
maxidx: int, (*maximum index of any Var or TVar*) |
60cc0359363d
promise: include check into future body, i.e. joined results are always valid;
wenzelm
parents:
28364
diff
changeset
|
343 |
shyps: sort OrdList.T, (*sort hypotheses*) |
60cc0359363d
promise: include check into future body, i.e. joined results are always valid;
wenzelm
parents:
28364
diff
changeset
|
344 |
hyps: term OrdList.T, (*hypotheses*) |
60cc0359363d
promise: include check into future body, i.e. joined results are always valid;
wenzelm
parents:
28364
diff
changeset
|
345 |
tpairs: (term * term) list, (*flex-flex pairs*) |
60cc0359363d
promise: include check into future body, i.e. joined results are always valid;
wenzelm
parents:
28364
diff
changeset
|
346 |
prop: term} (*conclusion*) |
28624 | 347 |
and deriv = Deriv of |
28996
01918abaa9e7
refined type deriv: replaced all_promises by max_promise (dependency limit) and open_promises (potentially unfinished/failed promises);
wenzelm
parents:
28992
diff
changeset
|
348 |
{max_promise: serial, |
01918abaa9e7
refined type deriv: replaced all_promises by max_promise (dependency limit) and open_promises (potentially unfinished/failed promises);
wenzelm
parents:
28992
diff
changeset
|
349 |
open_promises: (serial * thm future) OrdList.T, |
28978
f3e37d78b4f7
future proofs: pass actual futures to facilitate composite computations;
wenzelm
parents:
28874
diff
changeset
|
350 |
promises: (serial * thm future) OrdList.T, |
28804
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
351 |
body: Pt.proof_body}; |
0 | 352 |
|
23601 | 353 |
type conv = cterm -> thm; |
354 |
||
22365 | 355 |
(*attributes subsume any kind of rules or context modifiers*) |
356 |
type attribute = Context.generic * thm -> Context.generic * thm; |
|
357 |
||
16725 | 358 |
(*errors involving theorems*) |
359 |
exception THM of string * int * thm list; |
|
13658
c9ad3e64ddcf
Changed handling of flex-flex constraints: now stored in separate
berghofe
parents:
13642
diff
changeset
|
360 |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
361 |
fun rep_thm (Thm (_, args)) = args; |
0 | 362 |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
363 |
fun crep_thm (Thm (_, {thy_ref, tags, maxidx, shyps, hyps, tpairs, prop})) = |
26631
d6b6c74a8bcf
rep_cterm/rep_thm: no longer dereference theory_ref;
wenzelm
parents:
26424
diff
changeset
|
364 |
let fun cterm max t = Cterm {thy_ref = thy_ref, t = t, T = propT, maxidx = max, sorts = shyps} in |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
365 |
{thy_ref = thy_ref, tags = tags, maxidx = maxidx, shyps = shyps, |
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
366 |
hyps = map (cterm ~1) hyps, |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
367 |
tpairs = map (pairself (cterm maxidx)) tpairs, |
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
368 |
prop = cterm maxidx prop} |
1517 | 369 |
end; |
370 |
||
31947
7daee3bed3af
clarified strip_shyps: proper type witnesses for present sorts;
wenzelm
parents:
31945
diff
changeset
|
371 |
fun fold_terms f (Thm (_, {tpairs, prop, hyps, ...})) = |
7daee3bed3af
clarified strip_shyps: proper type witnesses for present sorts;
wenzelm
parents:
31945
diff
changeset
|
372 |
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
|
373 |
|
16725 | 374 |
fun terms_of_tpairs tpairs = fold_rev (fn (t, u) => cons t o cons u) tpairs []; |
375 |
||
376 |
fun eq_tpairs ((t, u), (t', u')) = t aconv t' andalso u aconv u'; |
|
18944 | 377 |
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
|
378 |
val maxidx_tpairs = fold (fn (t, u) => Term.maxidx_term t #> Term.maxidx_term u); |
16725 | 379 |
|
380 |
fun attach_tpairs tpairs prop = |
|
381 |
Logic.list_implies (map Logic.mk_equals tpairs, prop); |
|
382 |
||
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
383 |
fun full_prop_of (Thm (_, {tpairs, prop, ...})) = attach_tpairs tpairs prop; |
16945 | 384 |
|
29269
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29003
diff
changeset
|
385 |
val union_hyps = OrdList.union TermOrd.fast_term_ord; |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29003
diff
changeset
|
386 |
val insert_hyps = OrdList.insert TermOrd.fast_term_ord; |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29003
diff
changeset
|
387 |
val remove_hyps = OrdList.remove TermOrd.fast_term_ord; |
22365 | 388 |
|
16945 | 389 |
|
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
390 |
(* merge theories of cterms/thms -- trivial absorption only *) |
16945 | 391 |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
392 |
fun merge_thys1 (Cterm {thy_ref = r1, ...}) (th as Thm (_, {thy_ref = r2, ...})) = |
23601 | 393 |
Theory.merge_refs (r1, r2); |
16945 | 394 |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
395 |
fun merge_thys2 (th1 as Thm (_, {thy_ref = r1, ...})) (th2 as Thm (_, {thy_ref = r2, ...})) = |
23601 | 396 |
Theory.merge_refs (r1, r2); |
16945 | 397 |
|
0 | 398 |
|
22365 | 399 |
(* basic components *) |
16135 | 400 |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
401 |
val theory_of_thm = Theory.deref o #thy_ref o rep_thm; |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
402 |
val maxidx_of = #maxidx o rep_thm; |
19910 | 403 |
fun maxidx_thm th i = Int.max (maxidx_of th, i); |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
404 |
val hyps_of = #hyps o rep_thm; |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
405 |
val prop_of = #prop o rep_thm; |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
406 |
val tpairs_of = #tpairs o rep_thm; |
0 | 407 |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
408 |
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
|
409 |
val prems_of = Logic.strip_imp_prems o prop_of; |
21576 | 410 |
val nprems_of = Logic.count_prems o prop_of; |
19305 | 411 |
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
|
412 |
|
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
413 |
fun major_prem_of th = |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
414 |
(case prems_of th of |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
415 |
prem :: _ => Logic.strip_assums_concl prem |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
416 |
| [] => 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
|
417 |
|
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
418 |
(*the statement of any thm is a cterm*) |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
419 |
fun cprop_of (Thm (_, {thy_ref, maxidx, shyps, prop, ...})) = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
420 |
Cterm {thy_ref = thy_ref, maxidx = maxidx, T = propT, t = prop, sorts = shyps}; |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
421 |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
422 |
fun cprem_of (th as Thm (_, {thy_ref, maxidx, shyps, prop, ...})) i = |
18035 | 423 |
Cterm {thy_ref = thy_ref, maxidx = maxidx, T = propT, sorts = shyps, |
18145 | 424 |
t = Logic.nth_prem (i, prop) handle TERM _ => raise THM ("cprem_of", i, [th])}; |
18035 | 425 |
|
16656 | 426 |
(*explicit transfer to a super theory*) |
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
427 |
fun transfer thy' thm = |
3895 | 428 |
let |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
429 |
val Thm (der, {thy_ref, tags, maxidx, shyps, hyps, tpairs, prop}) = thm; |
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
430 |
val thy = Theory.deref thy_ref; |
26665 | 431 |
val _ = Theory.subthy (thy, thy') orelse raise THM ("transfer: not a super theory", 0, [thm]); |
432 |
val is_eq = Theory.eq_thy (thy, thy'); |
|
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
433 |
val _ = Theory.check_thy thy; |
3895 | 434 |
in |
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
435 |
if is_eq then thm |
16945 | 436 |
else |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
437 |
Thm (der, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
438 |
{thy_ref = Theory.check_thy thy', |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
439 |
tags = tags, |
16945 | 440 |
maxidx = maxidx, |
441 |
shyps = shyps, |
|
442 |
hyps = hyps, |
|
443 |
tpairs = tpairs, |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
444 |
prop = prop}) |
3895 | 445 |
end; |
387
69f4356d915d
new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents:
309
diff
changeset
|
446 |
|
16945 | 447 |
(*explicit weakening: maps |- B to A |- B*) |
448 |
fun weaken raw_ct th = |
|
449 |
let |
|
20261 | 450 |
val ct as Cterm {t = A, T, sorts, maxidx = maxidxA, ...} = adjust_maxidx_cterm ~1 raw_ct; |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
451 |
val Thm (der, {tags, maxidx, shyps, hyps, tpairs, prop, ...}) = th; |
16945 | 452 |
in |
453 |
if T <> propT then |
|
454 |
raise THM ("weaken: assumptions must have type prop", 0, []) |
|
455 |
else if maxidxA <> ~1 then |
|
456 |
raise THM ("weaken: assumptions may not contain schematic variables", maxidxA, []) |
|
457 |
else |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
458 |
Thm (der, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
459 |
{thy_ref = merge_thys1 ct th, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
460 |
tags = tags, |
16945 | 461 |
maxidx = maxidx, |
462 |
shyps = Sorts.union sorts shyps, |
|
28354 | 463 |
hyps = insert_hyps A hyps, |
16945 | 464 |
tpairs = tpairs, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
465 |
prop = prop}) |
16945 | 466 |
end; |
16656 | 467 |
|
28624 | 468 |
fun weaken_sorts raw_sorts ct = |
469 |
let |
|
470 |
val Cterm {thy_ref, t, T, maxidx, sorts} = ct; |
|
471 |
val thy = Theory.deref thy_ref; |
|
472 |
val more_sorts = Sorts.make (map (Sign.certify_sort thy) raw_sorts); |
|
473 |
val sorts' = Sorts.union sorts more_sorts; |
|
474 |
in Cterm {thy_ref = Theory.check_thy thy, t = t, T = T, maxidx = maxidx, sorts = sorts'} end; |
|
475 |
||
16656 | 476 |
|
0 | 477 |
|
1238 | 478 |
(** sort contexts of theorems **) |
479 |
||
31947
7daee3bed3af
clarified strip_shyps: proper type witnesses for present sorts;
wenzelm
parents:
31945
diff
changeset
|
480 |
(*remove extra sorts that are witnessed by type signature information*) |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
481 |
fun strip_shyps (thm as Thm (_, {shyps = [], ...})) = thm |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
482 |
| strip_shyps (thm as Thm (der, {thy_ref, tags, maxidx, shyps, hyps, tpairs, prop})) = |
7642 | 483 |
let |
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
484 |
val thy = Theory.deref thy_ref; |
31947
7daee3bed3af
clarified strip_shyps: proper type witnesses for present sorts;
wenzelm
parents:
31945
diff
changeset
|
485 |
val present = |
7daee3bed3af
clarified strip_shyps: proper type witnesses for present sorts;
wenzelm
parents:
31945
diff
changeset
|
486 |
(fold_terms o fold_types o fold_atyps) |
7daee3bed3af
clarified strip_shyps: proper type witnesses for present sorts;
wenzelm
parents:
31945
diff
changeset
|
487 |
(fn T as TFree (_, S) => insert (eq_snd op =) (T, S) |
7daee3bed3af
clarified strip_shyps: proper type witnesses for present sorts;
wenzelm
parents:
31945
diff
changeset
|
488 |
| T as TVar (_, S) => insert (eq_snd op =) (T, S)) thm []; |
7daee3bed3af
clarified strip_shyps: proper type witnesses for present sorts;
wenzelm
parents:
31945
diff
changeset
|
489 |
val extra = fold (Sorts.remove_sort o #2) present shyps; |
7daee3bed3af
clarified strip_shyps: proper type witnesses for present sorts;
wenzelm
parents:
31945
diff
changeset
|
490 |
val witnessed = Sign.witness_sorts thy present extra; |
7daee3bed3af
clarified strip_shyps: proper type witnesses for present sorts;
wenzelm
parents:
31945
diff
changeset
|
491 |
val extra' = fold (Sorts.remove_sort o #2) witnessed extra |
28624 | 492 |
|> Sorts.minimal_sorts (Sign.classes_of thy); |
31947
7daee3bed3af
clarified strip_shyps: proper type witnesses for present sorts;
wenzelm
parents:
31945
diff
changeset
|
493 |
val shyps' = fold (Sorts.insert_sort o #2) present extra'; |
7642 | 494 |
in |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
495 |
Thm (der, {thy_ref = Theory.check_thy thy, tags = tags, maxidx = maxidx, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
496 |
shyps = shyps', hyps = hyps, tpairs = tpairs, prop = prop}) |
7642 | 497 |
end; |
1238 | 498 |
|
16656 | 499 |
(*dangling sort constraints of a thm*) |
31947
7daee3bed3af
clarified strip_shyps: proper type witnesses for present sorts;
wenzelm
parents:
31945
diff
changeset
|
500 |
fun extra_shyps (th as Thm (_, {shyps, ...})) = |
7daee3bed3af
clarified strip_shyps: proper type witnesses for present sorts;
wenzelm
parents:
31945
diff
changeset
|
501 |
Sorts.subtract (fold_terms Sorts.insert_term th []) shyps; |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
502 |
|
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
503 |
|
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
504 |
|
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
505 |
(** derivations **) |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
506 |
|
28996
01918abaa9e7
refined type deriv: replaced all_promises by max_promise (dependency limit) and open_promises (potentially unfinished/failed promises);
wenzelm
parents:
28992
diff
changeset
|
507 |
fun make_deriv max_promise open_promises promises oracles thms proof = |
01918abaa9e7
refined type deriv: replaced all_promises by max_promise (dependency limit) and open_promises (potentially unfinished/failed promises);
wenzelm
parents:
28992
diff
changeset
|
508 |
Deriv {max_promise = max_promise, open_promises = open_promises, promises = promises, |
28804
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
509 |
body = PBody {oracles = oracles, thms = thms, proof = proof}}; |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
510 |
|
28996
01918abaa9e7
refined type deriv: replaced all_promises by max_promise (dependency limit) and open_promises (potentially unfinished/failed promises);
wenzelm
parents:
28992
diff
changeset
|
511 |
val empty_deriv = make_deriv ~1 [] [] [] [] Pt.MinProof; |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
512 |
|
28330 | 513 |
|
28354 | 514 |
(* inference rules *) |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
515 |
|
28378
60cc0359363d
promise: include check into future body, i.e. joined results are always valid;
wenzelm
parents:
28364
diff
changeset
|
516 |
fun promise_ord ((i, _), (j, _)) = int_ord (j, i); |
28330 | 517 |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
518 |
fun deriv_rule2 f |
28996
01918abaa9e7
refined type deriv: replaced all_promises by max_promise (dependency limit) and open_promises (potentially unfinished/failed promises);
wenzelm
parents:
28992
diff
changeset
|
519 |
(Deriv {max_promise = max1, open_promises = open_ps1, promises = ps1, |
28804
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
520 |
body = PBody {oracles = oras1, thms = thms1, proof = prf1}}) |
28996
01918abaa9e7
refined type deriv: replaced all_promises by max_promise (dependency limit) and open_promises (potentially unfinished/failed promises);
wenzelm
parents:
28992
diff
changeset
|
521 |
(Deriv {max_promise = max2, open_promises = open_ps2, promises = ps2, |
28804
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
522 |
body = PBody {oracles = oras2, thms = thms2, proof = prf2}}) = |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
523 |
let |
28996
01918abaa9e7
refined type deriv: replaced all_promises by max_promise (dependency limit) and open_promises (potentially unfinished/failed promises);
wenzelm
parents:
28992
diff
changeset
|
524 |
val max = Int.max (max1, max2); |
01918abaa9e7
refined type deriv: replaced all_promises by max_promise (dependency limit) and open_promises (potentially unfinished/failed promises);
wenzelm
parents:
28992
diff
changeset
|
525 |
val open_ps = OrdList.union promise_ord open_ps1 open_ps2; |
28330 | 526 |
val ps = OrdList.union promise_ord ps1 ps2; |
28804
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
527 |
val oras = Pt.merge_oracles oras1 oras2; |
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
528 |
val thms = Pt.merge_thms thms1 thms2; |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
529 |
val prf = |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
530 |
(case ! Pt.proofs of |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
531 |
2 => f prf1 prf2 |
28804
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
532 |
| 1 => MinProof |
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
533 |
| 0 => MinProof |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
534 |
| i => error ("Illegal level of detail for proof objects: " ^ string_of_int i)); |
28996
01918abaa9e7
refined type deriv: replaced all_promises by max_promise (dependency limit) and open_promises (potentially unfinished/failed promises);
wenzelm
parents:
28992
diff
changeset
|
535 |
in make_deriv max open_ps ps oras thms prf end; |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
536 |
|
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
537 |
fun deriv_rule1 f = deriv_rule2 (K f) empty_deriv; |
28996
01918abaa9e7
refined type deriv: replaced all_promises by max_promise (dependency limit) and open_promises (potentially unfinished/failed promises);
wenzelm
parents:
28992
diff
changeset
|
538 |
fun deriv_rule0 prf = deriv_rule1 I (make_deriv ~1 [] [] [] [] prf); |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
539 |
|
1238 | 540 |
|
541 |
||
1529 | 542 |
(** Axioms **) |
387
69f4356d915d
new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents:
309
diff
changeset
|
543 |
|
28675
fb68c0767004
renamed get_axiom_i to axiom, removed obsolete get_axiom;
wenzelm
parents:
28648
diff
changeset
|
544 |
fun axiom theory name = |
387
69f4356d915d
new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents:
309
diff
changeset
|
545 |
let |
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
546 |
fun get_ax thy = |
22685 | 547 |
Symtab.lookup (Theory.axiom_table thy) name |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
548 |
|> 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
|
549 |
let |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
550 |
val der = deriv_rule0 (Pt.axm_proof name prop); |
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
551 |
val maxidx = maxidx_of_term prop; |
26640
92e6d3ec91bd
simplified handling of sorts, removed unnecessary universal witness;
wenzelm
parents:
26631
diff
changeset
|
552 |
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
|
553 |
in |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
554 |
Thm (der, {thy_ref = Theory.check_thy thy, tags = [], |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
555 |
maxidx = maxidx, 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
|
556 |
end); |
387
69f4356d915d
new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents:
309
diff
changeset
|
557 |
in |
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
558 |
(case get_first get_ax (theory :: Theory.ancestors_of theory) of |
15531 | 559 |
SOME thm => thm |
560 |
| NONE => raise THEORY ("No axiom " ^ quote name, [theory])) |
|
387
69f4356d915d
new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents:
309
diff
changeset
|
561 |
end; |
69f4356d915d
new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents:
309
diff
changeset
|
562 |
|
776
df8f91c0e57c
improved axioms_of: returns thms as the manual says;
wenzelm
parents:
721
diff
changeset
|
563 |
(*return additional axioms of this theory node*) |
df8f91c0e57c
improved axioms_of: returns thms as the manual says;
wenzelm
parents:
721
diff
changeset
|
564 |
fun axioms_of thy = |
28675
fb68c0767004
renamed get_axiom_i to axiom, removed obsolete get_axiom;
wenzelm
parents:
28648
diff
changeset
|
565 |
map (fn s => (s, axiom thy s)) (Symtab.keys (Theory.axiom_table thy)); |
776
df8f91c0e57c
improved axioms_of: returns thms as the manual says;
wenzelm
parents:
721
diff
changeset
|
566 |
|
6089 | 567 |
|
28804
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
568 |
(* tags *) |
6089 | 569 |
|
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
570 |
val get_tags = #tags o rep_thm; |
6089 | 571 |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
572 |
fun map_tags f (Thm (der, {thy_ref, tags, maxidx, shyps, hyps, tpairs, prop})) = |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
573 |
Thm (der, {thy_ref = thy_ref, tags = f tags, maxidx = maxidx, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
574 |
shyps = shyps, hyps = hyps, tpairs = tpairs, prop = prop}); |
0 | 575 |
|
576 |
||
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
577 |
fun norm_proof (Thm (der, args as {thy_ref, ...})) = |
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
578 |
let |
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
579 |
val thy = Theory.deref thy_ref; |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
580 |
val der' = deriv_rule1 (Pt.rew_proof thy) der; |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
581 |
val _ = Theory.check_thy thy; |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
582 |
in Thm (der', args) end; |
23781
ab793a6ddf9f
Added function norm_proof for normalizing the proof term
berghofe
parents:
23657
diff
changeset
|
583 |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
584 |
fun adjust_maxidx_thm i (th as Thm (der, {thy_ref, tags, maxidx, shyps, hyps, tpairs, prop})) = |
20261 | 585 |
if maxidx = i then th |
586 |
else if maxidx < i then |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
587 |
Thm (der, {maxidx = i, thy_ref = thy_ref, tags = tags, shyps = shyps, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
588 |
hyps = hyps, tpairs = tpairs, prop = prop}) |
20261 | 589 |
else |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
590 |
Thm (der, {maxidx = Int.max (maxidx_tpairs tpairs (maxidx_of_term prop), i), thy_ref = thy_ref, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
591 |
tags = tags, shyps = shyps, hyps = hyps, tpairs = tpairs, prop = prop}); |
564 | 592 |
|
387
69f4356d915d
new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents:
309
diff
changeset
|
593 |
|
2509 | 594 |
|
1529 | 595 |
(*** Meta rules ***) |
0 | 596 |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
597 |
(** primitive rules **) |
0 | 598 |
|
16656 | 599 |
(*The assumption rule A |- A*) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
600 |
fun assume raw_ct = |
20261 | 601 |
let val Cterm {thy_ref, 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
|
602 |
if T <> propT then |
19230 | 603 |
raise THM ("assume: prop", 0, []) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
604 |
else if maxidx <> ~1 then |
19230 | 605 |
raise THM ("assume: variables", maxidx, []) |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
606 |
else Thm (deriv_rule0 (Pt.Hyp prop), |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
607 |
{thy_ref = thy_ref, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
608 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
609 |
maxidx = ~1, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
610 |
shyps = sorts, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
611 |
hyps = [prop], |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
612 |
tpairs = [], |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
613 |
prop = prop}) |
0 | 614 |
end; |
615 |
||
1220 | 616 |
(*Implication introduction |
3529 | 617 |
[A] |
618 |
: |
|
619 |
B |
|
1220 | 620 |
------- |
621 |
A ==> B |
|
622 |
*) |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
623 |
fun implies_intr |
16679 | 624 |
(ct as Cterm {t = A, T, maxidx = maxidxA, sorts, ...}) |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
625 |
(th as Thm (der, {maxidx, hyps, shyps, tpairs, prop, ...})) = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
626 |
if T <> propT then |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
627 |
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
|
628 |
else |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
629 |
Thm (deriv_rule1 (Pt.implies_intr_proof A) der, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
630 |
{thy_ref = merge_thys1 ct th, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
631 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
632 |
maxidx = Int.max (maxidxA, maxidx), |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
633 |
shyps = Sorts.union sorts shyps, |
28354 | 634 |
hyps = remove_hyps A hyps, |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
635 |
tpairs = tpairs, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
636 |
prop = Logic.mk_implies (A, prop)}); |
0 | 637 |
|
1529 | 638 |
|
1220 | 639 |
(*Implication elimination |
640 |
A ==> B A |
|
641 |
------------ |
|
642 |
B |
|
643 |
*) |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
644 |
fun implies_elim thAB thA = |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
645 |
let |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
646 |
val Thm (derA, {maxidx = maxA, hyps = hypsA, shyps = shypsA, tpairs = tpairsA, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
647 |
prop = propA, ...}) = thA |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
648 |
and Thm (der, {maxidx, hyps, shyps, tpairs, prop, ...}) = thAB; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
649 |
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
|
650 |
in |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
651 |
case prop of |
20512 | 652 |
Const ("==>", _) $ A $ B => |
653 |
if A aconv propA then |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
654 |
Thm (deriv_rule2 (curry Pt.%%) der derA, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
655 |
{thy_ref = merge_thys2 thAB thA, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
656 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
657 |
maxidx = Int.max (maxA, maxidx), |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
658 |
shyps = Sorts.union shypsA shyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
659 |
hyps = union_hyps hypsA hyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
660 |
tpairs = union_tpairs tpairsA tpairs, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
661 |
prop = B}) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
662 |
else err () |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
663 |
| _ => err () |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
664 |
end; |
250 | 665 |
|
1220 | 666 |
(*Forall introduction. The Free or Var x must not be free in the hypotheses. |
16656 | 667 |
[x] |
668 |
: |
|
669 |
A |
|
670 |
------ |
|
671 |
!!x. A |
|
1220 | 672 |
*) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
673 |
fun forall_intr |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
674 |
(ct as Cterm {t = x, T, sorts, ...}) |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
675 |
(th as Thm (der, {maxidx, shyps, hyps, tpairs, prop, ...})) = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
676 |
let |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
677 |
fun result a = |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
678 |
Thm (deriv_rule1 (Pt.forall_intr_proof x a) der, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
679 |
{thy_ref = merge_thys1 ct th, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
680 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
681 |
maxidx = maxidx, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
682 |
shyps = Sorts.union sorts shyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
683 |
hyps = hyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
684 |
tpairs = tpairs, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
685 |
prop = Term.all T $ Abs (a, T, abstract_over (x, prop))}); |
21798 | 686 |
fun check_occs a x ts = |
16847
8fc160b12e73
invoke_oracle: do not keep theory value, but theory_ref;
wenzelm
parents:
16725
diff
changeset
|
687 |
if exists (fn t => Logic.occs (x, t)) ts then |
21798 | 688 |
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
|
689 |
else (); |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
690 |
in |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
691 |
case x of |
21798 | 692 |
Free (a, _) => (check_occs a x hyps; check_occs a x (terms_of_tpairs tpairs); result a) |
693 |
| Var ((a, _), _) => (check_occs a x (terms_of_tpairs tpairs); result a) |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
694 |
| _ => raise THM ("forall_intr: not a variable", 0, [th]) |
0 | 695 |
end; |
696 |
||
1220 | 697 |
(*Forall elimination |
16656 | 698 |
!!x. A |
1220 | 699 |
------ |
700 |
A[t/x] |
|
701 |
*) |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
702 |
fun forall_elim |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
703 |
(ct as Cterm {t, T, maxidx = maxt, sorts, ...}) |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
704 |
(th as Thm (der, {maxidx, shyps, hyps, tpairs, prop, ...})) = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
705 |
(case prop of |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
706 |
Const ("all", Type ("fun", [Type ("fun", [qary, _]), _])) $ A => |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
707 |
if T <> qary then |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
708 |
raise THM ("forall_elim: type mismatch", 0, [th]) |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
709 |
else |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
710 |
Thm (deriv_rule1 (Pt.% o rpair (SOME t)) der, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
711 |
{thy_ref = merge_thys1 ct th, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
712 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
713 |
maxidx = Int.max (maxidx, maxt), |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
714 |
shyps = Sorts.union sorts shyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
715 |
hyps = hyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
716 |
tpairs = tpairs, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
717 |
prop = Term.betapply (A, t)}) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
718 |
| _ => raise THM ("forall_elim: not quantified", 0, [th])); |
0 | 719 |
|
720 |
||
1220 | 721 |
(* Equality *) |
0 | 722 |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
723 |
(*Reflexivity |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
724 |
t == t |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
725 |
*) |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
726 |
fun reflexive (ct as Cterm {thy_ref, t, T, maxidx, sorts}) = |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
727 |
Thm (deriv_rule0 Pt.reflexive, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
728 |
{thy_ref = thy_ref, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
729 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
730 |
maxidx = maxidx, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
731 |
shyps = sorts, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
732 |
hyps = [], |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
733 |
tpairs = [], |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
734 |
prop = Logic.mk_equals (t, t)}); |
0 | 735 |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
736 |
(*Symmetry |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
737 |
t == u |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
738 |
------ |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
739 |
u == t |
1220 | 740 |
*) |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
741 |
fun symmetric (th as Thm (der, {thy_ref, maxidx, shyps, hyps, tpairs, prop, ...})) = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
742 |
(case prop of |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
743 |
(eq as Const ("==", Type (_, [T, _]))) $ t $ u => |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
744 |
Thm (deriv_rule1 Pt.symmetric der, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
745 |
{thy_ref = thy_ref, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
746 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
747 |
maxidx = maxidx, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
748 |
shyps = shyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
749 |
hyps = hyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
750 |
tpairs = tpairs, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
751 |
prop = eq $ u $ t}) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
752 |
| _ => raise THM ("symmetric", 0, [th])); |
0 | 753 |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
754 |
(*Transitivity |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
755 |
t1 == u u == t2 |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
756 |
------------------ |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
757 |
t1 == t2 |
1220 | 758 |
*) |
0 | 759 |
fun transitive th1 th2 = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
760 |
let |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
761 |
val Thm (der1, {maxidx = max1, hyps = hyps1, shyps = shyps1, tpairs = tpairs1, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
762 |
prop = prop1, ...}) = th1 |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
763 |
and Thm (der2, {maxidx = max2, hyps = hyps2, shyps = shyps2, tpairs = tpairs2, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
764 |
prop = prop2, ...}) = th2; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
765 |
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
|
766 |
in |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
767 |
case (prop1, prop2) of |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
768 |
((eq as Const ("==", Type (_, [T, _]))) $ t1 $ u, Const ("==", _) $ u' $ t2) => |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
769 |
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
|
770 |
else |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
771 |
Thm (deriv_rule2 (Pt.transitive u T) der1 der2, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
772 |
{thy_ref = merge_thys2 th1 th2, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
773 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
774 |
maxidx = Int.max (max1, max2), |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
775 |
shyps = Sorts.union shyps1 shyps2, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
776 |
hyps = union_hyps hyps1 hyps2, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
777 |
tpairs = union_tpairs tpairs1 tpairs2, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
778 |
prop = eq $ t1 $ t2}) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
779 |
| _ => err "premises" |
0 | 780 |
end; |
781 |
||
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
782 |
(*Beta-conversion |
16656 | 783 |
(%x. t)(u) == t[u/x] |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
784 |
fully beta-reduces the term if full = true |
10416
5b33e732e459
- Moved rewriting functions to meta_simplifier.ML
berghofe
parents:
10348
diff
changeset
|
785 |
*) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
786 |
fun beta_conversion full (Cterm {thy_ref, t, T, maxidx, sorts}) = |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
787 |
let val t' = |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
788 |
if full then Envir.beta_norm t |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
789 |
else |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
790 |
(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
|
791 |
| _ => raise THM ("beta_conversion: not a redex", 0, [])); |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
792 |
in |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
793 |
Thm (deriv_rule0 Pt.reflexive, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
794 |
{thy_ref = thy_ref, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
795 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
796 |
maxidx = maxidx, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
797 |
shyps = sorts, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
798 |
hyps = [], |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
799 |
tpairs = [], |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
800 |
prop = Logic.mk_equals (t, t')}) |
10416
5b33e732e459
- Moved rewriting functions to meta_simplifier.ML
berghofe
parents:
10348
diff
changeset
|
801 |
end; |
5b33e732e459
- Moved rewriting functions to meta_simplifier.ML
berghofe
parents:
10348
diff
changeset
|
802 |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
803 |
fun eta_conversion (Cterm {thy_ref, t, T, maxidx, sorts}) = |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
804 |
Thm (deriv_rule0 Pt.reflexive, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
805 |
{thy_ref = thy_ref, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
806 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
807 |
maxidx = maxidx, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
808 |
shyps = sorts, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
809 |
hyps = [], |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
810 |
tpairs = [], |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
811 |
prop = Logic.mk_equals (t, Envir.eta_contract t)}); |
0 | 812 |
|
23493 | 813 |
fun eta_long_conversion (Cterm {thy_ref, t, T, maxidx, sorts}) = |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
814 |
Thm (deriv_rule0 Pt.reflexive, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
815 |
{thy_ref = thy_ref, |
23493 | 816 |
tags = [], |
817 |
maxidx = maxidx, |
|
818 |
shyps = sorts, |
|
819 |
hyps = [], |
|
820 |
tpairs = [], |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
821 |
prop = Logic.mk_equals (t, Pattern.eta_long [] t)}); |
23493 | 822 |
|
0 | 823 |
(*The abstraction rule. The Free or Var x must not be free in the hypotheses. |
824 |
The bound variable will be named "a" (since x will be something like x320) |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
825 |
t == u |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
826 |
-------------- |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
827 |
%x. t == %x. u |
1220 | 828 |
*) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
829 |
fun abstract_rule a |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
830 |
(Cterm {t = x, T, sorts, ...}) |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
831 |
(th as Thm (der, {thy_ref, maxidx, hyps, shyps, tpairs, prop, ...})) = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
832 |
let |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
833 |
val (t, u) = Logic.dest_equals prop |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
834 |
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
|
835 |
val result = |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
836 |
Thm (deriv_rule1 (Pt.abstract_rule x a) der, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
837 |
{thy_ref = thy_ref, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
838 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
839 |
maxidx = maxidx, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
840 |
shyps = Sorts.union sorts shyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
841 |
hyps = hyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
842 |
tpairs = tpairs, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
843 |
prop = Logic.mk_equals |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
844 |
(Abs (a, T, abstract_over (x, t)), Abs (a, T, abstract_over (x, u)))}); |
21798 | 845 |
fun check_occs a x ts = |
16847
8fc160b12e73
invoke_oracle: do not keep theory value, but theory_ref;
wenzelm
parents:
16725
diff
changeset
|
846 |
if exists (fn t => Logic.occs (x, t)) ts then |
21798 | 847 |
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
|
848 |
else (); |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
849 |
in |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
850 |
case x of |
21798 | 851 |
Free (a, _) => (check_occs a x hyps; check_occs a x (terms_of_tpairs tpairs); result) |
852 |
| Var ((a, _), _) => (check_occs a x (terms_of_tpairs tpairs); result) |
|
853 |
| _ => raise THM ("abstract_rule: not a variable", 0, [th]) |
|
0 | 854 |
end; |
855 |
||
856 |
(*The combination rule |
|
3529 | 857 |
f == g t == u |
858 |
-------------- |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
859 |
f t == g u |
1220 | 860 |
*) |
0 | 861 |
fun combination th1 th2 = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
862 |
let |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
863 |
val Thm (der1, {maxidx = max1, shyps = shyps1, hyps = hyps1, tpairs = tpairs1, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
864 |
prop = prop1, ...}) = th1 |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
865 |
and Thm (der2, {maxidx = max2, shyps = shyps2, hyps = hyps2, tpairs = tpairs2, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
866 |
prop = prop2, ...}) = th2; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
867 |
fun chktypes fT tT = |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
868 |
(case fT of |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
869 |
Type ("fun", [T1, T2]) => |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
870 |
if T1 <> tT then |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
871 |
raise THM ("combination: types", 0, [th1, th2]) |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
872 |
else () |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
873 |
| _ => 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
|
874 |
in |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
875 |
case (prop1, prop2) of |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
876 |
(Const ("==", Type ("fun", [fT, _])) $ f $ g, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
877 |
Const ("==", Type ("fun", [tT, _])) $ t $ u) => |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
878 |
(chktypes fT tT; |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
879 |
Thm (deriv_rule2 (Pt.combination f g t u fT) der1 der2, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
880 |
{thy_ref = merge_thys2 th1 th2, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
881 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
882 |
maxidx = Int.max (max1, max2), |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
883 |
shyps = Sorts.union shyps1 shyps2, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
884 |
hyps = union_hyps hyps1 hyps2, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
885 |
tpairs = union_tpairs tpairs1 tpairs2, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
886 |
prop = Logic.mk_equals (f $ t, g $ u)})) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
887 |
| _ => raise THM ("combination: premises", 0, [th1, th2]) |
0 | 888 |
end; |
889 |
||
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
890 |
(*Equality introduction |
3529 | 891 |
A ==> B B ==> A |
892 |
---------------- |
|
893 |
A == B |
|
1220 | 894 |
*) |
0 | 895 |
fun equal_intr th1 th2 = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
896 |
let |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
897 |
val Thm (der1, {maxidx = max1, shyps = shyps1, hyps = hyps1, tpairs = tpairs1, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
898 |
prop = prop1, ...}) = th1 |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
899 |
and Thm (der2, {maxidx = max2, shyps = shyps2, hyps = hyps2, tpairs = tpairs2, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
900 |
prop = prop2, ...}) = th2; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
901 |
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
|
902 |
in |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
903 |
case (prop1, prop2) of |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
904 |
(Const("==>", _) $ A $ B, Const("==>", _) $ B' $ A') => |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
905 |
if A aconv A' andalso B aconv B' then |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
906 |
Thm (deriv_rule2 (Pt.equal_intr A B) der1 der2, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
907 |
{thy_ref = merge_thys2 th1 th2, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
908 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
909 |
maxidx = Int.max (max1, max2), |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
910 |
shyps = Sorts.union shyps1 shyps2, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
911 |
hyps = union_hyps hyps1 hyps2, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
912 |
tpairs = union_tpairs tpairs1 tpairs2, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
913 |
prop = Logic.mk_equals (A, B)}) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
914 |
else err "not equal" |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
915 |
| _ => err "premises" |
1529 | 916 |
end; |
917 |
||
918 |
(*The equal propositions rule |
|
3529 | 919 |
A == B A |
1529 | 920 |
--------- |
921 |
B |
|
922 |
*) |
|
923 |
fun equal_elim th1 th2 = |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
924 |
let |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
925 |
val Thm (der1, {maxidx = max1, shyps = shyps1, hyps = hyps1, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
926 |
tpairs = tpairs1, prop = prop1, ...}) = th1 |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
927 |
and Thm (der2, {maxidx = max2, shyps = shyps2, hyps = hyps2, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
928 |
tpairs = tpairs2, prop = prop2, ...}) = th2; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
929 |
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
|
930 |
in |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
931 |
case prop1 of |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
932 |
Const ("==", _) $ A $ B => |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
933 |
if prop2 aconv A then |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
934 |
Thm (deriv_rule2 (Pt.equal_elim A B) der1 der2, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
935 |
{thy_ref = merge_thys2 th1 th2, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
936 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
937 |
maxidx = Int.max (max1, max2), |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
938 |
shyps = Sorts.union shyps1 shyps2, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
939 |
hyps = union_hyps hyps1 hyps2, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
940 |
tpairs = union_tpairs tpairs1 tpairs2, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
941 |
prop = B}) |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
942 |
else err "not equal" |
1529 | 943 |
| _ => err"major premise" |
944 |
end; |
|
0 | 945 |
|
1220 | 946 |
|
947 |
||
0 | 948 |
(**** Derived rules ****) |
949 |
||
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
950 |
(*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
|
951 |
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
|
952 |
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
|
953 |
flex-flex.*) |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
954 |
fun flexflex_rule (th as Thm (der, {thy_ref, maxidx, shyps, hyps, tpairs, prop, ...})) = |
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
955 |
let val thy = Theory.deref thy_ref in |
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
956 |
Unify.smash_unifiers thy tpairs (Envir.empty maxidx) |
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
957 |
|> Seq.map (fn env => |
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
958 |
if Envir.is_empty env then th |
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
959 |
else |
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
960 |
let |
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
961 |
val tpairs' = tpairs |> map (pairself (Envir.norm_term env)) |
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
962 |
(*remove trivial tpairs, of the form t==t*) |
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
963 |
|> filter_out (op aconv); |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
964 |
val der' = deriv_rule1 (Pt.norm_proof' env) der; |
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
965 |
val prop' = Envir.norm_term env prop; |
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
966 |
val maxidx = maxidx_tpairs tpairs' (maxidx_of_term prop'); |
26640
92e6d3ec91bd
simplified handling of sorts, removed unnecessary universal witness;
wenzelm
parents:
26631
diff
changeset
|
967 |
val shyps = Envir.insert_sorts env shyps; |
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
968 |
in |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
969 |
Thm (der', {thy_ref = Theory.check_thy thy, tags = [], maxidx = maxidx, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
970 |
shyps = shyps, hyps = hyps, tpairs = tpairs', prop = prop'}) |
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
971 |
end) |
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
972 |
end; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
973 |
|
0 | 974 |
|
19910 | 975 |
(*Generalization of fixed variables |
976 |
A |
|
977 |
-------------------- |
|
978 |
A[?'a/'a, ?x/x, ...] |
|
979 |
*) |
|
980 |
||
981 |
fun generalize ([], []) _ th = th |
|
982 |
| generalize (tfrees, frees) idx th = |
|
983 |
let |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
984 |
val Thm (der, {thy_ref, maxidx, shyps, hyps, tpairs, prop, ...}) = th; |
19910 | 985 |
val _ = idx <= maxidx andalso raise THM ("generalize: bad index", idx, [th]); |
986 |
||
987 |
val bad_type = if null tfrees then K false else |
|
988 |
Term.exists_subtype (fn TFree (a, _) => member (op =) tfrees a | _ => false); |
|
989 |
fun bad_term (Free (x, T)) = bad_type T orelse member (op =) frees x |
|
990 |
| bad_term (Var (_, T)) = bad_type T |
|
991 |
| bad_term (Const (_, T)) = bad_type T |
|
992 |
| bad_term (Abs (_, T, t)) = bad_type T orelse bad_term t |
|
993 |
| bad_term (t $ u) = bad_term t orelse bad_term u |
|
994 |
| bad_term (Bound _) = false; |
|
995 |
val _ = exists bad_term hyps andalso |
|
996 |
raise THM ("generalize: variable free in assumptions", 0, [th]); |
|
997 |
||
31977 | 998 |
val gen = Term_Subst.generalize (tfrees, frees) idx; |
19910 | 999 |
val prop' = gen prop; |
1000 |
val tpairs' = map (pairself gen) tpairs; |
|
1001 |
val maxidx' = maxidx_tpairs tpairs' (maxidx_of_term prop'); |
|
1002 |
in |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1003 |
Thm (deriv_rule1 (Pt.generalize (tfrees, frees) idx) der, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1004 |
{thy_ref = thy_ref, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1005 |
tags = [], |
19910 | 1006 |
maxidx = maxidx', |
1007 |
shyps = shyps, |
|
1008 |
hyps = hyps, |
|
1009 |
tpairs = tpairs', |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1010 |
prop = prop'}) |
19910 | 1011 |
end; |
1012 |
||
1013 |
||
22584 | 1014 |
(*Instantiation of schematic variables |
16656 | 1015 |
A |
1016 |
-------------------- |
|
1017 |
A[t1/v1, ..., tn/vn] |
|
1220 | 1018 |
*) |
0 | 1019 |
|
6928 | 1020 |
local |
1021 |
||
26939
1035c89b4c02
moved global pretty/string_of functions from Sign to Syntax;
wenzelm
parents:
26832
diff
changeset
|
1022 |
fun pretty_typing thy t T = Pretty.block |
1035c89b4c02
moved global pretty/string_of functions from Sign to Syntax;
wenzelm
parents:
26832
diff
changeset
|
1023 |
[Syntax.pretty_term_global thy t, Pretty.str " ::", Pretty.brk 1, Syntax.pretty_typ_global thy T]; |
15797 | 1024 |
|
16884
1678a796b6b2
tuned instantiate (avoid subst_atomic, subst_atomic_types);
wenzelm
parents:
16847
diff
changeset
|
1025 |
fun add_inst (ct, cu) (thy_ref, sorts) = |
6928 | 1026 |
let |
26939
1035c89b4c02
moved global pretty/string_of functions from Sign to Syntax;
wenzelm
parents:
26832
diff
changeset
|
1027 |
val Cterm {t = t, T = T, ...} = ct; |
1035c89b4c02
moved global pretty/string_of functions from Sign to Syntax;
wenzelm
parents:
26832
diff
changeset
|
1028 |
val Cterm {t = u, T = U, sorts = sorts_u, maxidx = maxidx_u, ...} = cu; |
16884
1678a796b6b2
tuned instantiate (avoid subst_atomic, subst_atomic_types);
wenzelm
parents:
16847
diff
changeset
|
1029 |
val thy_ref' = Theory.merge_refs (thy_ref, merge_thys0 ct cu); |
1678a796b6b2
tuned instantiate (avoid subst_atomic, subst_atomic_types);
wenzelm
parents:
16847
diff
changeset
|
1030 |
val sorts' = Sorts.union sorts_u sorts; |
3967
edd5ff9371f8
sg_ref: automatic adjustment of thms of draft theories;
wenzelm
parents:
3895
diff
changeset
|
1031 |
in |
16884
1678a796b6b2
tuned instantiate (avoid subst_atomic, subst_atomic_types);
wenzelm
parents:
16847
diff
changeset
|
1032 |
(case t of Var v => |
20512 | 1033 |
if T = U then ((v, (u, maxidx_u)), (thy_ref', sorts')) |
16884
1678a796b6b2
tuned instantiate (avoid subst_atomic, subst_atomic_types);
wenzelm
parents:
16847
diff
changeset
|
1034 |
else raise TYPE (Pretty.string_of (Pretty.block |
1678a796b6b2
tuned instantiate (avoid subst_atomic, subst_atomic_types);
wenzelm
parents:
16847
diff
changeset
|
1035 |
[Pretty.str "instantiate: type conflict", |
1678a796b6b2
tuned instantiate (avoid subst_atomic, subst_atomic_types);
wenzelm
parents:
16847
diff
changeset
|
1036 |
Pretty.fbrk, pretty_typing (Theory.deref thy_ref') t T, |
1678a796b6b2
tuned instantiate (avoid subst_atomic, subst_atomic_types);
wenzelm
parents:
16847
diff
changeset
|
1037 |
Pretty.fbrk, pretty_typing (Theory.deref thy_ref') u U]), [T, U], [t, u]) |
1678a796b6b2
tuned instantiate (avoid subst_atomic, subst_atomic_types);
wenzelm
parents:
16847
diff
changeset
|
1038 |
| _ => raise TYPE (Pretty.string_of (Pretty.block |
1678a796b6b2
tuned instantiate (avoid subst_atomic, subst_atomic_types);
wenzelm
parents:
16847
diff
changeset
|
1039 |
[Pretty.str "instantiate: not a variable", |
26939
1035c89b4c02
moved global pretty/string_of functions from Sign to Syntax;
wenzelm
parents:
26832
diff
changeset
|
1040 |
Pretty.fbrk, Syntax.pretty_term_global (Theory.deref thy_ref') t]), [], [t])) |
0 | 1041 |
end; |
1042 |
||
16884
1678a796b6b2
tuned instantiate (avoid subst_atomic, subst_atomic_types);
wenzelm
parents:
16847
diff
changeset
|
1043 |
fun add_instT (cT, cU) (thy_ref, sorts) = |
16656 | 1044 |
let |
16884
1678a796b6b2
tuned instantiate (avoid subst_atomic, subst_atomic_types);
wenzelm
parents:
16847
diff
changeset
|
1045 |
val Ctyp {T, thy_ref = thy_ref1, ...} = cT |
20512 | 1046 |
and Ctyp {T = U, thy_ref = thy_ref2, sorts = sorts_U, maxidx = maxidx_U, ...} = cU; |
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
1047 |
val thy' = Theory.deref (Theory.merge_refs (thy_ref, Theory.merge_refs (thy_ref1, thy_ref2))); |
16884
1678a796b6b2
tuned instantiate (avoid subst_atomic, subst_atomic_types);
wenzelm
parents:
16847
diff
changeset
|
1048 |
val sorts' = Sorts.union sorts_U sorts; |
16656 | 1049 |
in |
16884
1678a796b6b2
tuned instantiate (avoid subst_atomic, subst_atomic_types);
wenzelm
parents:
16847
diff
changeset
|
1050 |
(case T of TVar (v as (_, S)) => |
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
1051 |
if Sign.of_sort thy' (U, S) then ((v, (U, maxidx_U)), (Theory.check_thy thy', sorts')) |
26939
1035c89b4c02
moved global pretty/string_of functions from Sign to Syntax;
wenzelm
parents:
26832
diff
changeset
|
1052 |
else raise TYPE ("Type not of sort " ^ Syntax.string_of_sort_global thy' S, [U], []) |
16656 | 1053 |
| _ => raise TYPE (Pretty.string_of (Pretty.block |
15797 | 1054 |
[Pretty.str "instantiate: not a type variable", |
26939
1035c89b4c02
moved global pretty/string_of functions from Sign to Syntax;
wenzelm
parents:
26832
diff
changeset
|
1055 |
Pretty.fbrk, Syntax.pretty_typ_global thy' T]), [T], [])) |
16656 | 1056 |
end; |
0 | 1057 |
|
6928 | 1058 |
in |
1059 |
||
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1060 |
(*Left-to-right replacements: ctpairs = [..., (vi, ti), ...]. |
0 | 1061 |
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
|
1062 |
Does NOT normalize the resulting theorem!*) |
1529 | 1063 |
fun instantiate ([], []) th = th |
16884
1678a796b6b2
tuned instantiate (avoid subst_atomic, subst_atomic_types);
wenzelm
parents:
16847
diff
changeset
|
1064 |
| instantiate (instT, inst) th = |
16656 | 1065 |
let |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1066 |
val Thm (der, {thy_ref, hyps, shyps, tpairs, prop, ...}) = th; |
16884
1678a796b6b2
tuned instantiate (avoid subst_atomic, subst_atomic_types);
wenzelm
parents:
16847
diff
changeset
|
1067 |
val (inst', (instT', (thy_ref', shyps'))) = |
1678a796b6b2
tuned instantiate (avoid subst_atomic, subst_atomic_types);
wenzelm
parents:
16847
diff
changeset
|
1068 |
(thy_ref, shyps) |> fold_map add_inst inst ||> fold_map add_instT instT; |
31977 | 1069 |
val subst = Term_Subst.instantiate_maxidx (instT', inst'); |
20512 | 1070 |
val (prop', maxidx1) = subst prop ~1; |
1071 |
val (tpairs', maxidx') = |
|
1072 |
fold_map (fn (t, u) => fn i => subst t i ||>> subst u) tpairs maxidx1; |
|
16656 | 1073 |
in |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1074 |
Thm (deriv_rule1 (fn d => Pt.instantiate (map (apsnd #1) instT', map (apsnd #1) inst') d) der, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1075 |
{thy_ref = thy_ref', |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1076 |
tags = [], |
20545
4c1068697159
instantiate: omit has_duplicates check, which is irrelevant for soundness;
wenzelm
parents:
20512
diff
changeset
|
1077 |
maxidx = maxidx', |
4c1068697159
instantiate: omit has_duplicates check, which is irrelevant for soundness;
wenzelm
parents:
20512
diff
changeset
|
1078 |
shyps = shyps', |
4c1068697159
instantiate: omit has_duplicates check, which is irrelevant for soundness;
wenzelm
parents:
20512
diff
changeset
|
1079 |
hyps = hyps, |
4c1068697159
instantiate: omit has_duplicates check, which is irrelevant for soundness;
wenzelm
parents:
20512
diff
changeset
|
1080 |
tpairs = tpairs', |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1081 |
prop = prop'}) |
16656 | 1082 |
end |
1083 |
handle TYPE (msg, _, _) => raise THM (msg, 0, [th]); |
|
6928 | 1084 |
|
22584 | 1085 |
fun instantiate_cterm ([], []) ct = ct |
1086 |
| instantiate_cterm (instT, inst) ct = |
|
1087 |
let |
|
1088 |
val Cterm {thy_ref, t, T, sorts, ...} = ct; |
|
1089 |
val (inst', (instT', (thy_ref', sorts'))) = |
|
1090 |
(thy_ref, sorts) |> fold_map add_inst inst ||> fold_map add_instT instT; |
|
31977 | 1091 |
val subst = Term_Subst.instantiate_maxidx (instT', inst'); |
1092 |
val substT = Term_Subst.instantiateT_maxidx instT'; |
|
22584 | 1093 |
val (t', maxidx1) = subst t ~1; |
1094 |
val (T', maxidx') = substT T maxidx1; |
|
1095 |
in Cterm {thy_ref = thy_ref', t = t', T = T', sorts = sorts', maxidx = maxidx'} end |
|
1096 |
handle TYPE (msg, _, _) => raise CTERM (msg, [ct]); |
|
1097 |
||
6928 | 1098 |
end; |
1099 |
||
0 | 1100 |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1101 |
(*The trivial implication A ==> A, justified by assume and forall rules. |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1102 |
A can contain Vars, not so for assume!*) |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1103 |
fun trivial (Cterm {thy_ref, t =A, T, maxidx, sorts}) = |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1104 |
if T <> propT then |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1105 |
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
|
1106 |
else |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1107 |
Thm (deriv_rule0 (Pt.AbsP ("H", NONE, Pt.PBound 0)), |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1108 |
{thy_ref = thy_ref, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1109 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1110 |
maxidx = maxidx, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1111 |
shyps = sorts, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1112 |
hyps = [], |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1113 |
tpairs = [], |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1114 |
prop = Logic.mk_implies (A, A)}); |
0 | 1115 |
|
31944 | 1116 |
(*Axiom-scheme reflecting signature contents |
1117 |
T :: c |
|
1118 |
------------------- |
|
1119 |
OFCLASS(T, c_class) |
|
1120 |
*) |
|
1121 |
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
|
1122 |
let |
31944 | 1123 |
val Ctyp {thy_ref, T, ...} = cT; |
1124 |
val thy = Theory.deref thy_ref; |
|
31903 | 1125 |
val c = Sign.certify_class thy raw_c; |
31944 | 1126 |
val Cterm {t = prop, maxidx, sorts, ...} = cterm_of thy (Logic.mk_of_class (T, c)); |
399
86cc2b98f9e0
added class_triv: theory -> class -> thm (for axclasses);
wenzelm
parents:
387
diff
changeset
|
1127 |
in |
31944 | 1128 |
if Sign.of_sort thy (T, [c]) then |
1129 |
Thm (deriv_rule0 (Pt.OfClass (T, c)), |
|
1130 |
{thy_ref = Theory.check_thy thy, |
|
1131 |
tags = [], |
|
1132 |
maxidx = maxidx, |
|
1133 |
shyps = sorts, |
|
1134 |
hyps = [], |
|
1135 |
tpairs = [], |
|
1136 |
prop = prop}) |
|
1137 |
else raise THM ("of_class: type not of class " ^ Syntax.string_of_sort_global thy [c], 0, []) |
|
399
86cc2b98f9e0
added class_triv: theory -> class -> thm (for axclasses);
wenzelm
parents:
387
diff
changeset
|
1138 |
end; |
86cc2b98f9e0
added class_triv: theory -> class -> thm (for axclasses);
wenzelm
parents:
387
diff
changeset
|
1139 |
|
19505 | 1140 |
(*Internalize sort constraints of type variable*) |
1141 |
fun unconstrainT |
|
1142 |
(Ctyp {thy_ref = thy_ref1, T, ...}) |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1143 |
(th as Thm (_, {thy_ref = thy_ref2, maxidx, shyps, hyps, tpairs, prop, ...})) = |
19505 | 1144 |
let |
1145 |
val ((x, i), S) = Term.dest_TVar T handle TYPE _ => |
|
1146 |
raise THM ("unconstrainT: not a type variable", 0, [th]); |
|
1147 |
val T' = TVar ((x, i), []); |
|
20548
8ef25fe585a8
renamed Term.map_term_types to Term.map_types (cf. Term.fold_types);
wenzelm
parents:
20545
diff
changeset
|
1148 |
val unconstrain = Term.map_types (Term.map_atyps (fn U => if U = T then T' else U)); |
31943
5e960a0780a2
renamed inclass/Inclass to of_class/OfClass, in accordance to of_sort;
wenzelm
parents:
31905
diff
changeset
|
1149 |
val constraints = map (curry Logic.mk_of_class T') S; |
19505 | 1150 |
in |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1151 |
Thm (deriv_rule0 (Pt.PAxm ("Pure.unconstrainT", prop, SOME [])), |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1152 |
{thy_ref = Theory.merge_refs (thy_ref1, thy_ref2), |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1153 |
tags = [], |
19505 | 1154 |
maxidx = Int.max (maxidx, i), |
1155 |
shyps = Sorts.remove_sort S shyps, |
|
1156 |
hyps = hyps, |
|
1157 |
tpairs = map (pairself unconstrain) tpairs, |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1158 |
prop = Logic.list_implies (constraints, unconstrain prop)}) |
19505 | 1159 |
end; |
399
86cc2b98f9e0
added class_triv: theory -> class -> thm (for axclasses);
wenzelm
parents:
387
diff
changeset
|
1160 |
|
6786 | 1161 |
(* Replace all TFrees not fixed or in the hyps by new TVars *) |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1162 |
fun varifyT' fixed (Thm (der, {thy_ref, maxidx, shyps, hyps, tpairs, prop, ...})) = |
12500 | 1163 |
let |
29272 | 1164 |
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
|
1165 |
val prop1 = attach_tpairs tpairs prop; |
21116 | 1166 |
val (al, prop2) = Type.varify tfrees prop1; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1167 |
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
|
1168 |
in |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1169 |
(al, Thm (deriv_rule1 (Pt.varify_proof prop tfrees) der, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1170 |
{thy_ref = thy_ref, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1171 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1172 |
maxidx = Int.max (0, maxidx), |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1173 |
shyps = shyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1174 |
hyps = hyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1175 |
tpairs = rev (map Logic.dest_equals ts), |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1176 |
prop = prop3})) |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1177 |
end; |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1178 |
|
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1179 |
val varifyT = #2 o varifyT' []; |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1180 |
|
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1181 |
(* Replace all TVars by new TFrees *) |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1182 |
fun freezeT (Thm (der, {thy_ref, maxidx, shyps, hyps, tpairs, prop, ...})) = |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1183 |
let |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1184 |
val prop1 = attach_tpairs tpairs prop; |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1185 |
val prop2 = Type.freeze prop1; |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1186 |
val (ts, prop3) = Logic.strip_prems (length tpairs, [], prop2); |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1187 |
in |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1188 |
Thm (deriv_rule1 (Pt.freezeT prop1) der, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1189 |
{thy_ref = thy_ref, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1190 |
tags = [], |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1191 |
maxidx = maxidx_of_term prop2, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1192 |
shyps = shyps, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1193 |
hyps = hyps, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1194 |
tpairs = rev (map Logic.dest_equals ts), |
18127 | 1195 |
prop = prop3}) |
0 | 1196 |
end; |
1197 |
||
1198 |
||
1199 |
(*** Inference rules for tactics ***) |
|
1200 |
||
1201 |
(*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
|
1202 |
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
|
1203 |
(case Logic.strip_prems(i, [], prop) of |
c9ad3e64ddcf
Changed handling of flex-flex constraints: now stored in separate
berghofe
parents:
13642
diff
changeset
|
1204 |
(B::rBs, C) => (tpairs, rev rBs, B, C) |
c9ad3e64ddcf
Changed handling of flex-flex constraints: now stored in separate
berghofe
parents:
13642
diff
changeset
|
1205 |
| _ => raise THM("dest_state", i, [state])) |
0 | 1206 |
handle TERM _ => raise THM("dest_state", i, [state]); |
1207 |
||
309 | 1208 |
(*Increment variables and parameters of orule as required for |
18035 | 1209 |
resolution with a goal.*) |
1210 |
fun lift_rule goal orule = |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1211 |
let |
18035 | 1212 |
val Cterm {t = gprop, T, maxidx = gmax, sorts, ...} = goal; |
1213 |
val inc = gmax + 1; |
|
1214 |
val lift_abs = Logic.lift_abs inc gprop; |
|
1215 |
val lift_all = Logic.lift_all inc gprop; |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1216 |
val Thm (der, {maxidx, shyps, hyps, tpairs, prop, ...}) = orule; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1217 |
val (As, B) = Logic.strip_horn prop; |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1218 |
in |
18035 | 1219 |
if T <> propT then raise THM ("lift_rule: the term must have type prop", 0, []) |
1220 |
else |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1221 |
Thm (deriv_rule1 (Pt.lift_proof gprop inc prop) der, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1222 |
{thy_ref = merge_thys1 goal orule, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1223 |
tags = [], |
18035 | 1224 |
maxidx = maxidx + inc, |
1225 |
shyps = Sorts.union shyps sorts, (*sic!*) |
|
1226 |
hyps = hyps, |
|
1227 |
tpairs = map (pairself lift_abs) tpairs, |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1228 |
prop = Logic.list_implies (map lift_all As, lift_all B)}) |
0 | 1229 |
end; |
1230 |
||
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1231 |
fun incr_indexes i (thm as Thm (der, {thy_ref, maxidx, shyps, hyps, tpairs, prop, ...})) = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1232 |
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
|
1233 |
else if i = 0 then thm |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1234 |
else |
32027 | 1235 |
Thm (deriv_rule1 (Pt.incr_indexes i) der, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1236 |
{thy_ref = thy_ref, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1237 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1238 |
maxidx = maxidx + i, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1239 |
shyps = shyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1240 |
hyps = hyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1241 |
tpairs = map (pairself (Logic.incr_indexes ([], i))) tpairs, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1242 |
prop = Logic.incr_indexes ([], i) prop}); |
10416
5b33e732e459
- Moved rewriting functions to meta_simplifier.ML
berghofe
parents:
10348
diff
changeset
|
1243 |
|
0 | 1244 |
(*Solve subgoal Bi of proof state B1...Bn/C by assumption. *) |
1245 |
fun assumption i state = |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1246 |
let |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1247 |
val Thm (der, {thy_ref, maxidx, shyps, hyps, prop, ...}) = state; |
16656 | 1248 |
val thy = Theory.deref thy_ref; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1249 |
val (tpairs, Bs, Bi, C) = dest_state (state, i); |
32032 | 1250 |
fun newth n (env, tpairs) = |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1251 |
Thm (deriv_rule1 |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1252 |
((if Envir.is_empty env then I else (Pt.norm_proof' env)) o |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1253 |
Pt.assumption_proof Bs Bi n) der, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1254 |
{tags = [], |
32032 | 1255 |
maxidx = Envir.maxidx_of env, |
26640
92e6d3ec91bd
simplified handling of sorts, removed unnecessary universal witness;
wenzelm
parents:
26631
diff
changeset
|
1256 |
shyps = Envir.insert_sorts env shyps, |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1257 |
hyps = hyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1258 |
tpairs = |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1259 |
if Envir.is_empty env then tpairs |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1260 |
else map (pairself (Envir.norm_term env)) tpairs, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1261 |
prop = |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1262 |
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
|
1263 |
Logic.list_implies (Bs, C) |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1264 |
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
|
1265 |
Envir.norm_term env (Logic.list_implies (Bs, C)), |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1266 |
thy_ref = Theory.check_thy thy}); |
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
|
1267 |
|
30556
7be15917f3fa
eq_assumption: slightly more efficient by checking (open) result of Logic.assum_problems directly;
wenzelm
parents:
30554
diff
changeset
|
1268 |
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
|
1269 |
val concl' = close concl; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1270 |
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
|
1271 |
| 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
|
1272 |
(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
|
1273 |
(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
|
1274 |
(Unify.unifiers (thy, 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
|
1275 |
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
|
1276 |
(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
|
1277 |
in addprfs asms 1 end; |
0 | 1278 |
|
250 | 1279 |
(*Solve subgoal Bi of proof state B1...Bn/C by assumption. |
0 | 1280 |
Checks if Bi's conclusion is alpha-convertible to one of its assumptions*) |
1281 |
fun eq_assumption i state = |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1282 |
let |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1283 |
val Thm (der, {thy_ref, maxidx, shyps, hyps, prop, ...}) = state; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1284 |
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
|
1285 |
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
|
1286 |
in |
30556
7be15917f3fa
eq_assumption: slightly more efficient by checking (open) result of Logic.assum_problems directly;
wenzelm
parents:
30554
diff
changeset
|
1287 |
(case find_index (fn asm => Pattern.aeconv (asm, concl)) asms of |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1288 |
~1 => raise THM ("eq_assumption", 0, [state]) |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1289 |
| n => |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1290 |
Thm (deriv_rule1 (Pt.assumption_proof Bs Bi (n + 1)) der, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1291 |
{thy_ref = thy_ref, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1292 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1293 |
maxidx = maxidx, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1294 |
shyps = shyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1295 |
hyps = hyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1296 |
tpairs = tpairs, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1297 |
prop = Logic.list_implies (Bs, C)})) |
0 | 1298 |
end; |
1299 |
||
1300 |
||
2671 | 1301 |
(*For rotate_tac: fast rotation of assumptions of subgoal i*) |
1302 |
fun rotate_rule k i state = |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1303 |
let |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1304 |
val Thm (der, {thy_ref, maxidx, shyps, hyps, prop, ...}) = state; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1305 |
val (tpairs, Bs, Bi, C) = dest_state (state, i); |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1306 |
val params = Term.strip_all_vars Bi |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1307 |
and rest = Term.strip_all_body Bi; |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1308 |
val asms = Logic.strip_imp_prems rest |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1309 |
and concl = Logic.strip_imp_concl rest; |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1310 |
val n = length asms; |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1311 |
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
|
1312 |
val Bi' = |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1313 |
if 0 = m orelse m = n then Bi |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1314 |
else if 0 < m andalso m < n then |
19012 | 1315 |
let val (ps, qs) = chop m asms |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1316 |
in list_all (params, Logic.list_implies (qs @ ps, concl)) end |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1317 |
else raise THM ("rotate_rule", k, [state]); |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1318 |
in |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1319 |
Thm (deriv_rule1 (Pt.rotate_proof Bs Bi m) der, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1320 |
{thy_ref = thy_ref, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1321 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1322 |
maxidx = maxidx, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1323 |
shyps = shyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1324 |
hyps = hyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1325 |
tpairs = tpairs, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1326 |
prop = Logic.list_implies (Bs @ [Bi'], C)}) |
2671 | 1327 |
end; |
1328 |
||
1329 |
||
7248
322151fe6f02
new primitive rule permute_prems to underlie defer_tac and rotate_prems
paulson
parents:
7070
diff
changeset
|
1330 |
(*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
|
1331 |
unchanged. Does nothing if k=0 or if k equals n-j, where n is the |
16656 | 1332 |
number of premises. Useful with etac and underlies defer_tac*) |
7248
322151fe6f02
new primitive rule permute_prems to underlie defer_tac and rotate_prems
paulson
parents:
7070
diff
changeset
|
1333 |
fun permute_prems j k rl = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1334 |
let |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1335 |
val Thm (der, {thy_ref, maxidx, shyps, hyps, tpairs, prop, ...}) = rl; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1336 |
val prems = Logic.strip_imp_prems prop |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1337 |
and concl = Logic.strip_imp_concl prop; |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1338 |
val moved_prems = List.drop (prems, j) |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1339 |
and fixed_prems = List.take (prems, j) |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1340 |
handle Subscript => raise THM ("permute_prems: j", j, [rl]); |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1341 |
val n_j = length moved_prems; |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1342 |
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
|
1343 |
val prop' = |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1344 |
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
|
1345 |
else if 0 < m andalso m < n_j then |
19012 | 1346 |
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
|
1347 |
in Logic.list_implies (fixed_prems @ qs @ ps, concl) end |
16725 | 1348 |
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
|
1349 |
in |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1350 |
Thm (deriv_rule1 (Pt.permute_prems_prf prems j m) der, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1351 |
{thy_ref = thy_ref, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1352 |
tags = [], |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1353 |
maxidx = maxidx, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1354 |
shyps = shyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1355 |
hyps = hyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1356 |
tpairs = tpairs, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1357 |
prop = prop'}) |
7248
322151fe6f02
new primitive rule permute_prems to underlie defer_tac and rotate_prems
paulson
parents:
7070
diff
changeset
|
1358 |
end; |
322151fe6f02
new primitive rule permute_prems to underlie defer_tac and rotate_prems
paulson
parents:
7070
diff
changeset
|
1359 |
|
322151fe6f02
new primitive rule permute_prems to underlie defer_tac and rotate_prems
paulson
parents:
7070
diff
changeset
|
1360 |
|
0 | 1361 |
(** User renaming of parameters in a subgoal **) |
1362 |
||
1363 |
(*Calls error rather than raising an exception because it is intended |
|
1364 |
for top-level use -- exception handling would not make sense here. |
|
1365 |
The names in cs, if distinct, are used for the innermost parameters; |
|
17868 | 1366 |
preceding parameters may be renamed to make all params distinct.*) |
0 | 1367 |
fun rename_params_rule (cs, i) state = |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1368 |
let |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1369 |
val Thm (der, {thy_ref, tags, maxidx, shyps, hyps, ...}) = state; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1370 |
val (tpairs, Bs, Bi, C) = dest_state (state, i); |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1371 |
val iparams = map #1 (Logic.strip_params Bi); |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1372 |
val short = length iparams - length cs; |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1373 |
val newnames = |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1374 |
if short < 0 then error "More names than abstractions!" |
20071
8f3e1ddb50e6
replaced Term.variant(list) by Name.variant(_list);
wenzelm
parents:
20057
diff
changeset
|
1375 |
else Name.variant_list cs (Library.take (short, iparams)) @ cs; |
20330 | 1376 |
val freenames = Term.fold_aterms (fn Free (x, _) => insert (op =) x | _ => I) Bi []; |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1377 |
val newBi = Logic.list_rename_params (newnames, Bi); |
250 | 1378 |
in |
21182 | 1379 |
(case duplicates (op =) cs of |
1380 |
a :: _ => (warning ("Can't rename. Bound variables not distinct: " ^ a); state) |
|
1381 |
| [] => |
|
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1382 |
(case cs inter_string freenames of |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1383 |
a :: _ => (warning ("Can't rename. Bound/Free variable clash: " ^ a); state) |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1384 |
| [] => |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1385 |
Thm (der, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1386 |
{thy_ref = thy_ref, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1387 |
tags = tags, |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1388 |
maxidx = maxidx, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1389 |
shyps = shyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1390 |
hyps = hyps, |
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1391 |
tpairs = tpairs, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1392 |
prop = Logic.list_implies (Bs @ [newBi], C)}))) |
0 | 1393 |
end; |
1394 |
||
12982 | 1395 |
|
0 | 1396 |
(*** Preservation of bound variable names ***) |
1397 |
||
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1398 |
fun rename_boundvars pat obj (thm as Thm (der, {thy_ref, tags, maxidx, shyps, hyps, tpairs, prop})) = |
12982 | 1399 |
(case Term.rename_abs pat obj prop of |
15531 | 1400 |
NONE => thm |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1401 |
| SOME prop' => Thm (der, |
16425
2427be27cc60
accomodate identification of type Sign.sg and theory;
wenzelm
parents:
16352
diff
changeset
|
1402 |
{thy_ref = thy_ref, |
21646
c07b5b0e8492
thm/prf: separate official name vs. additional tags;
wenzelm
parents:
21576
diff
changeset
|
1403 |
tags = tags, |
12982 | 1404 |
maxidx = maxidx, |
1405 |
hyps = hyps, |
|
1406 |
shyps = shyps, |
|
13658
c9ad3e64ddcf
Changed handling of flex-flex constraints: now stored in separate
berghofe
parents:
13642
diff
changeset
|
1407 |
tpairs = tpairs, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1408 |
prop = prop'})); |
10416
5b33e732e459
- Moved rewriting functions to meta_simplifier.ML
berghofe
parents:
10348
diff
changeset
|
1409 |
|
0 | 1410 |
|
16656 | 1411 |
(* strip_apply f (A, B) strips off all assumptions/parameters from A |
0 | 1412 |
introduced by lifting over B, and applies f to remaining part of A*) |
1413 |
fun strip_apply f = |
|
1414 |
let fun strip(Const("==>",_)$ A1 $ B1, |
|
27336 | 1415 |
Const("==>",_)$ _ $ B2) = Logic.mk_implies (A1, strip(B1,B2)) |
250 | 1416 |
| strip((c as Const("all",_)) $ Abs(a,T,t1), |
1417 |
Const("all",_) $ Abs(_,_,t2)) = c$Abs(a,T,strip(t1,t2)) |
|
1418 |
| strip(A,_) = f A |
|
0 | 1419 |
in strip end; |
1420 |
||
1421 |
(*Use the alist to rename all bound variables and some unknowns in a term |
|
1422 |
dpairs = current disagreement pairs; tpairs = permanent ones (flexflex); |
|
1423 |
Preserves unknowns in tpairs and on lhs of dpairs. *) |
|
1424 |
fun rename_bvs([],_,_,_) = I |
|
1425 |
| rename_bvs(al,dpairs,tpairs,B) = |
|
20330 | 1426 |
let |
1427 |
val add_var = fold_aterms (fn Var ((x, _), _) => insert (op =) x | _ => I); |
|
1428 |
val vids = [] |
|
1429 |
|> fold (add_var o fst) dpairs |
|
1430 |
|> fold (add_var o fst) tpairs |
|
1431 |
|> fold (add_var o snd) tpairs; |
|
250 | 1432 |
(*unknowns appearing elsewhere be preserved!*) |
1433 |
fun rename(t as Var((x,i),T)) = |
|
20330 | 1434 |
(case AList.lookup (op =) al x of |
1435 |
SOME y => |
|
1436 |
if member (op =) vids x orelse member (op =) vids y then t |
|
1437 |
else Var((y,i),T) |
|
1438 |
| NONE=> t) |
|
0 | 1439 |
| rename(Abs(x,T,t)) = |
18944 | 1440 |
Abs (the_default x (AList.lookup (op =) al x), T, rename t) |
0 | 1441 |
| rename(f$t) = rename f $ rename t |
1442 |
| rename(t) = t; |
|
250 | 1443 |
fun strip_ren Ai = strip_apply rename (Ai,B) |
20330 | 1444 |
in strip_ren end; |
0 | 1445 |
|
1446 |
(*Function to rename bounds/unknowns in the argument, lifted over B*) |
|
1447 |
fun rename_bvars(dpairs, tpairs, B) = |
|
23178 | 1448 |
rename_bvs(List.foldr Term.match_bvars [] dpairs, dpairs, tpairs, B); |
0 | 1449 |
|
1450 |
||
1451 |
(*** RESOLUTION ***) |
|
1452 |
||
721
479832ff2d29
Pure/thm/norm_term_skip: new, for skipping normalization of the context
lcp
parents:
678
diff
changeset
|
1453 |
(** Lifting optimizations **) |
479832ff2d29
Pure/thm/norm_term_skip: new, for skipping normalization of the context
lcp
parents:
678
diff
changeset
|
1454 |
|
0 | 1455 |
(*strip off pairs of assumptions/parameters in parallel -- they are |
1456 |
identical because of lifting*) |
|
250 | 1457 |
fun strip_assums2 (Const("==>", _) $ _ $ B1, |
1458 |
Const("==>", _) $ _ $ B2) = strip_assums2 (B1,B2) |
|
0 | 1459 |
| strip_assums2 (Const("all",_)$Abs(a,T,t1), |
250 | 1460 |
Const("all",_)$Abs(_,_,t2)) = |
0 | 1461 |
let val (B1,B2) = strip_assums2 (t1,t2) |
1462 |
in (Abs(a,T,B1), Abs(a,T,B2)) end |
|
1463 |
| strip_assums2 BB = BB; |
|
1464 |
||
1465 |
||
721
479832ff2d29
Pure/thm/norm_term_skip: new, for skipping normalization of the context
lcp
parents:
678
diff
changeset
|
1466 |
(*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
|
1467 |
fun norm_term_skip env 0 t = Envir.norm_term env t |
32032 | 1468 |
| norm_term_skip env n (Const ("all", _) $ Abs (a, T, t)) = |
1469 |
let |
|
32035 | 1470 |
val T' = Envir.subst_type (Envir.type_env env) T |
32032 | 1471 |
(*Must instantiate types of parameters because they are flattened; |
1472 |
this could be a NEW parameter*) |
|
1473 |
in Term.all T' $ Abs (a, T', norm_term_skip env n t) end |
|
1474 |
| norm_term_skip env n (Const ("==>", _) $ A $ B) = |
|
1475 |
Logic.mk_implies (A, norm_term_skip env (n - 1) B) |
|
1476 |
| norm_term_skip env n t = 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
|
1477 |
|
479832ff2d29
Pure/thm/norm_term_skip: new, for skipping normalization of the context
lcp
parents:
678
diff
changeset
|
1478 |
|
0 | 1479 |
(*Composition of object rule r=(A1...Am/B) with proof state s=(B1...Bn/C) |
250 | 1480 |
Unifies B with Bi, replacing subgoal i (1 <= i <= n) |
0 | 1481 |
If match then forbid instantiations in proof state |
1482 |
If lifted then shorten the dpair using strip_assums2. |
|
1483 |
If eres_flg then simultaneously proves A1 by assumption. |
|
250 | 1484 |
nsubgoal is the number of new subgoals (written m above). |
0 | 1485 |
Curried so that resolution calls dest_state only once. |
1486 |
*) |
|
4270 | 1487 |
local exception COMPOSE |
0 | 1488 |
in |
18486 | 1489 |
fun bicompose_aux flatten match (state, (stpairs, Bs, Bi, C), lifted) |
0 | 1490 |
(eres_flg, orule, nsubgoal) = |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1491 |
let val Thm (sder, {maxidx=smax, shyps=sshyps, hyps=shyps, ...}) = state |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1492 |
and Thm (rder, {maxidx=rmax, shyps=rshyps, hyps=rhyps, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1493 |
tpairs=rtpairs, prop=rprop,...}) = orule |
1529 | 1494 |
(*How many hyps to skip over during normalization*) |
21576 | 1495 |
and nlift = Logic.count_prems (strip_all_body Bi) + (if eres_flg then ~1 else 0) |
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
1496 |
val thy = Theory.deref (merge_thys2 state orule); |
0 | 1497 |
(** Add new theorem with prop = '[| Bs; As |] ==> C' to thq **) |
32032 | 1498 |
fun addth A (As, oldAs, rder', n) ((env, tpairs), thq) = |
250 | 1499 |
let val normt = Envir.norm_term env; |
1500 |
(*perform minimal copying here by examining env*) |
|
13658
c9ad3e64ddcf
Changed handling of flex-flex constraints: now stored in separate
berghofe
parents:
13642
diff
changeset
|
1501 |
val (ntpairs, normp) = |
c9ad3e64ddcf
Changed handling of flex-flex constraints: now stored in separate
berghofe
parents:
13642
diff
changeset
|
1502 |
if Envir.is_empty env then (tpairs, (Bs @ As, C)) |
250 | 1503 |
else |
1504 |
let val ntps = map (pairself normt) tpairs |
|
19861 | 1505 |
in if Envir.above env smax then |
1238 | 1506 |
(*no assignments in state; normalize the rule only*) |
1507 |
if lifted |
|
13658
c9ad3e64ddcf
Changed handling of flex-flex constraints: now stored in separate
berghofe
parents:
13642
diff
changeset
|
1508 |
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
|
1509 |
else (ntps, (Bs @ map normt As, C)) |
1529 | 1510 |
else if match then raise COMPOSE |
250 | 1511 |
else (*normalize the new rule fully*) |
13658
c9ad3e64ddcf
Changed handling of flex-flex constraints: now stored in separate
berghofe
parents:
13642
diff
changeset
|
1512 |
(ntps, (map normt (Bs @ As), normt C)) |
250 | 1513 |
end |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1514 |
val th = |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1515 |
Thm (deriv_rule2 |
11518 | 1516 |
((if Envir.is_empty env then I |
19861 | 1517 |
else if Envir.above env smax then |
11518 | 1518 |
(fn f => fn der => f (Pt.norm_proof' env der)) |
1519 |
else |
|
1520 |
curry op oo (Pt.norm_proof' env)) |
|
23296
25f28f9c28a3
Adapted Proofterm.bicompose_proof to Larry's changes in
berghofe
parents:
23178
diff
changeset
|
1521 |
(Pt.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
|
1522 |
{tags = [], |
32032 | 1523 |
maxidx = Envir.maxidx_of env, |
26640
92e6d3ec91bd
simplified handling of sorts, removed unnecessary universal witness;
wenzelm
parents:
26631
diff
changeset
|
1524 |
shyps = Envir.insert_sorts env (Sorts.union rshyps sshyps), |
16601
ee8eefade568
more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents:
16425
diff
changeset
|
1525 |
hyps = union_hyps rhyps shyps, |
13658
c9ad3e64ddcf
Changed handling of flex-flex constraints: now stored in separate
berghofe
parents:
13642
diff
changeset
|
1526 |
tpairs = ntpairs, |
24143
90a9a6fe0d01
replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents:
23781
diff
changeset
|
1527 |
prop = Logic.list_implies normp, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1528 |
thy_ref = Theory.check_thy thy}) |
19475 | 1529 |
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
|
1530 |
val (rAs,B) = Logic.strip_prems(nsubgoal, [], rprop) |
0 | 1531 |
handle TERM _ => raise THM("bicompose: rule", 0, [orule,state]); |
1532 |
(*Modify assumptions, deleting n-th if n>0 for e-resolution*) |
|
1533 |
fun newAs(As0, n, dpairs, tpairs) = |
|
11518 | 1534 |
let val (As1, rder') = |
25939 | 1535 |
if not lifted then (As0, rder) |
11518 | 1536 |
else (map (rename_bvars(dpairs,tpairs,B)) As0, |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1537 |
deriv_rule1 (Pt.map_proof_terms |
11518 | 1538 |
(rename_bvars (dpairs, tpairs, Bound 0)) I) rder); |
18486 | 1539 |
in (map (if flatten then (Logic.flatten_params n) else I) As1, As1, rder', n) |
250 | 1540 |
handle TERM _ => |
1541 |
raise THM("bicompose: 1st premise", 0, [orule]) |
|
0 | 1542 |
end; |
2147 | 1543 |
val env = Envir.empty(Int.max(rmax,smax)); |
0 | 1544 |
val BBi = if lifted then strip_assums2(B,Bi) else (B,Bi); |
1545 |
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
|
1546 |
|
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
|
1547 |
(*elim-resolution: try each assumption in turn*) |
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
|
1548 |
fun eres [] = raise THM ("bicompose: no premises", 0, [orule, state]) |
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
|
1549 |
| eres (A1 :: As) = |
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
|
1550 |
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
|
1551 |
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
|
1552 |
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
|
1553 |
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
|
1554 |
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
|
1555 |
| tryasms (asm :: rest) n = |
7be15917f3fa
eq_assumption: slightly more efficient by checking (open) result of Logic.assum_problems directly;
wenzelm
parents:
30554
diff
changeset
|
1556 |
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
|
1557 |
let val asm' = close asm in |
7be15917f3fa
eq_assumption: slightly more efficient by checking (open) result of Logic.assum_problems directly;
wenzelm
parents:
30554
diff
changeset
|
1558 |
(case Seq.pull (Unify.unifiers (thy, 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
|
1559 |
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
|
1560 |
| 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
|
1561 |
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
|
1562 |
(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
|
1563 |
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
|
1564 |
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
|
1565 |
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
|
1566 |
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
|
1567 |
|
0 | 1568 |
(*ordinary resolution*) |
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
|
1569 |
fun res () = |
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
|
1570 |
(case Seq.pull (Unify.unifiers (thy, env, dpairs)) of |
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
|
1571 |
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
|
1572 |
| 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
|
1573 |
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
|
1574 |
(Seq.make (fn () => cell), 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
|
1575 |
in |
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
|
1576 |
if eres_flg then eres (rev rAs) else res () |
0 | 1577 |
end; |
7528 | 1578 |
end; |
0 | 1579 |
|
18501
915105af2e80
turned bicompose_no_flatten into compose_no_flatten, without elimination;
wenzelm
parents:
18486
diff
changeset
|
1580 |
fun compose_no_flatten match (orule, nsubgoal) i state = |
915105af2e80
turned bicompose_no_flatten into compose_no_flatten, without elimination;
wenzelm
parents:
18486
diff
changeset
|
1581 |
bicompose_aux false match (state, dest_state (state, i), false) (false, orule, nsubgoal); |
0 | 1582 |
|
18501
915105af2e80
turned bicompose_no_flatten into compose_no_flatten, without elimination;
wenzelm
parents:
18486
diff
changeset
|
1583 |
fun bicompose match arg i state = |
915105af2e80
turned bicompose_no_flatten into compose_no_flatten, without elimination;
wenzelm
parents:
18486
diff
changeset
|
1584 |
bicompose_aux true match (state, dest_state (state,i), false) arg; |
0 | 1585 |
|
1586 |
(*Quick test whether rule is resolvable with the subgoal with hyps Hs |
|
1587 |
and conclusion B. If eres_flg then checks 1st premise of rule also*) |
|
1588 |
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
|
1589 |
let fun could_reshyp (A1::_) = exists (fn H => Term.could_unify (A1, H)) Hs |
250 | 1590 |
| 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
|
1591 |
in Term.could_unify(concl_of rule, B) andalso |
250 | 1592 |
(not eres_flg orelse could_reshyp (prems_of rule)) |
0 | 1593 |
end; |
1594 |
||
1595 |
(*Bi-resolution of a state with a list of (flag,rule) pairs. |
|
1596 |
Puts the rule above: rule/state. Renames vars in the rules. *) |
|
250 | 1597 |
fun biresolution match brules i state = |
18035 | 1598 |
let val (stpairs, Bs, Bi, C) = dest_state(state,i); |
18145 | 1599 |
val lift = lift_rule (cprem_of state i); |
250 | 1600 |
val B = Logic.strip_assums_concl Bi; |
1601 |
val Hs = Logic.strip_assums_hyp Bi; |
|
22573 | 1602 |
val compose = bicompose_aux true match (state, (stpairs, Bs, Bi, C), true); |
4270 | 1603 |
fun res [] = Seq.empty |
250 | 1604 |
| res ((eres_flg, rule)::brules) = |
13642
a3d97348ceb6
added failure trace information to pattern unification
nipkow
parents:
13629
diff
changeset
|
1605 |
if !Pattern.trace_unify_fail orelse |
a3d97348ceb6
added failure trace information to pattern unification
nipkow
parents:
13629
diff
changeset
|
1606 |
could_bires (Hs, B, eres_flg, rule) |
4270 | 1607 |
then Seq.make (*delay processing remainder till needed*) |
22573 | 1608 |
(fn()=> SOME(compose (eres_flg, lift rule, nprems_of rule), |
250 | 1609 |
res brules)) |
1610 |
else res brules |
|
4270 | 1611 |
in Seq.flat (res brules) end; |
0 | 1612 |
|
1613 |
||
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1614 |
|
28978
f3e37d78b4f7
future proofs: pass actual futures to facilitate composite computations;
wenzelm
parents:
28874
diff
changeset
|
1615 |
(*** Future theorems -- proofs with promises ***) |
28356
ac4498f95d1c
abtract types: plain datatype with opaque signature matching;
wenzelm
parents:
28354
diff
changeset
|
1616 |
|
28446
a01de3b3fa2e
renamed promise to future, tuned related interfaces;
wenzelm
parents:
28441
diff
changeset
|
1617 |
(* future rule *) |
28330 | 1618 |
|
28446
a01de3b3fa2e
renamed promise to future, tuned related interfaces;
wenzelm
parents:
28441
diff
changeset
|
1619 |
fun future_result i orig_thy orig_shyps orig_prop raw_thm = |
28378
60cc0359363d
promise: include check into future body, i.e. joined results are always valid;
wenzelm
parents:
28364
diff
changeset
|
1620 |
let |
60cc0359363d
promise: include check into future body, i.e. joined results are always valid;
wenzelm
parents:
28364
diff
changeset
|
1621 |
val _ = Theory.check_thy orig_thy; |
60cc0359363d
promise: include check into future body, i.e. joined results are always valid;
wenzelm
parents:
28364
diff
changeset
|
1622 |
val thm = strip_shyps (transfer orig_thy raw_thm); |
60cc0359363d
promise: include check into future body, i.e. joined results are always valid;
wenzelm
parents:
28364
diff
changeset
|
1623 |
val _ = Theory.check_thy orig_thy; |
28446
a01de3b3fa2e
renamed promise to future, tuned related interfaces;
wenzelm
parents:
28441
diff
changeset
|
1624 |
fun err msg = raise THM ("future_result: " ^ msg, 0, [thm]); |
28378
60cc0359363d
promise: include check into future body, i.e. joined results are always valid;
wenzelm
parents:
28364
diff
changeset
|
1625 |
|
28996
01918abaa9e7
refined type deriv: replaced all_promises by max_promise (dependency limit) and open_promises (potentially unfinished/failed promises);
wenzelm
parents:
28992
diff
changeset
|
1626 |
val Thm (Deriv {max_promise, ...}, {shyps, hyps, tpairs, prop, ...}) = thm; |
28378
60cc0359363d
promise: include check into future body, i.e. joined results are always valid;
wenzelm
parents:
28364
diff
changeset
|
1627 |
val _ = prop aconv orig_prop orelse err "bad prop"; |
60cc0359363d
promise: include check into future body, i.e. joined results are always valid;
wenzelm
parents:
28364
diff
changeset
|
1628 |
val _ = null tpairs orelse err "bad tpairs"; |
60cc0359363d
promise: include check into future body, i.e. joined results are always valid;
wenzelm
parents:
28364
diff
changeset
|
1629 |
val _ = null hyps orelse err "bad hyps"; |
60cc0359363d
promise: include check into future body, i.e. joined results are always valid;
wenzelm
parents:
28364
diff
changeset
|
1630 |
val _ = Sorts.subset (shyps, orig_shyps) orelse err "bad shyps"; |
28996
01918abaa9e7
refined type deriv: replaced all_promises by max_promise (dependency limit) and open_promises (potentially unfinished/failed promises);
wenzelm
parents:
28992
diff
changeset
|
1631 |
val _ = max_promise < i orelse err "bad dependencies"; |
28378
60cc0359363d
promise: include check into future body, i.e. joined results are always valid;
wenzelm
parents:
28364
diff
changeset
|
1632 |
in thm end; |
60cc0359363d
promise: include check into future body, i.e. joined results are always valid;
wenzelm
parents:
28364
diff
changeset
|
1633 |
|
28978
f3e37d78b4f7
future proofs: pass actual futures to facilitate composite computations;
wenzelm
parents:
28874
diff
changeset
|
1634 |
fun future future_thm ct = |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1635 |
let |
28624 | 1636 |
val Cterm {thy_ref = thy_ref, t = prop, T, maxidx, sorts} = ct; |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1637 |
val thy = Context.reject_draft (Theory.deref thy_ref); |
28446
a01de3b3fa2e
renamed promise to future, tuned related interfaces;
wenzelm
parents:
28441
diff
changeset
|
1638 |
val _ = T <> propT andalso raise CTERM ("future: prop expected", [ct]); |
28378
60cc0359363d
promise: include check into future body, i.e. joined results are always valid;
wenzelm
parents:
28364
diff
changeset
|
1639 |
|
28389
777bdc429ea3
promise_result: enforce strictly sequential dependencies, via serial numbers;
wenzelm
parents:
28381
diff
changeset
|
1640 |
val i = serial (); |
29436
dc6b19966757
future_result: avoid expensive norm_proof (consider usedir option -Q false in low-memory situations);
wenzelm
parents:
29432
diff
changeset
|
1641 |
val future = future_thm |> Future.map (future_result i thy sorts prop); |
28829 | 1642 |
val promise = (i, future); |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1643 |
in |
28996
01918abaa9e7
refined type deriv: replaced all_promises by max_promise (dependency limit) and open_promises (potentially unfinished/failed promises);
wenzelm
parents:
28992
diff
changeset
|
1644 |
Thm (make_deriv i [promise] [promise] [] [] (Pt.promise_proof thy i prop), |
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1645 |
{thy_ref = thy_ref, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1646 |
tags = [], |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1647 |
maxidx = maxidx, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1648 |
shyps = sorts, |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1649 |
hyps = [], |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1650 |
tpairs = [], |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1651 |
prop = prop}) |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1652 |
end; |
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1653 |
|
28330 | 1654 |
|
30713
b1a87e3971a3
status_of: need to include local promises as well!
wenzelm
parents:
30711
diff
changeset
|
1655 |
(* derivation status *) |
b1a87e3971a3
status_of: need to include local promises as well!
wenzelm
parents:
30711
diff
changeset
|
1656 |
|
b1a87e3971a3
status_of: need to include local promises as well!
wenzelm
parents:
30711
diff
changeset
|
1657 |
fun raw_proof_body_of (Thm (Deriv {body, ...}, _)) = body; |
b1a87e3971a3
status_of: need to include local promises as well!
wenzelm
parents:
30711
diff
changeset
|
1658 |
val raw_proof_of = Proofterm.proof_of o raw_proof_body_of; |
29432
5bb5551bef03
added pending_groups -- accumulates task groups of local derivations only;
wenzelm
parents:
29288
diff
changeset
|
1659 |
|
5bb5551bef03
added pending_groups -- accumulates task groups of local derivations only;
wenzelm
parents:
29288
diff
changeset
|
1660 |
fun pending_groups (Thm (Deriv {open_promises, ...}, _)) = |
5bb5551bef03
added pending_groups -- accumulates task groups of local derivations only;
wenzelm
parents:
29288
diff
changeset
|
1661 |
fold (insert Task_Queue.eq_group o Future.group_of o #2) open_promises; |
5bb5551bef03
added pending_groups -- accumulates task groups of local derivations only;
wenzelm
parents:
29288
diff
changeset
|
1662 |
|
30713
b1a87e3971a3
status_of: need to include local promises as well!
wenzelm
parents:
30711
diff
changeset
|
1663 |
fun status_of (Thm (Deriv {promises, body, ...}, _)) = |
b1a87e3971a3
status_of: need to include local promises as well!
wenzelm
parents:
30711
diff
changeset
|
1664 |
let |
b1a87e3971a3
status_of: need to include local promises as well!
wenzelm
parents:
30711
diff
changeset
|
1665 |
val ps = map (Future.peek o snd) promises; |
b1a87e3971a3
status_of: need to include local promises as well!
wenzelm
parents:
30711
diff
changeset
|
1666 |
val bodies = body :: |
b1a87e3971a3
status_of: need to include local promises as well!
wenzelm
parents:
30711
diff
changeset
|
1667 |
map_filter (fn SOME (Exn.Result th) => SOME (raw_proof_body_of th) | _ => NONE) ps; |
b1a87e3971a3
status_of: need to include local promises as well!
wenzelm
parents:
30711
diff
changeset
|
1668 |
val {oracle, unfinished, failed} = Pt.status_of bodies; |
b1a87e3971a3
status_of: need to include local promises as well!
wenzelm
parents:
30711
diff
changeset
|
1669 |
in |
b1a87e3971a3
status_of: need to include local promises as well!
wenzelm
parents:
30711
diff
changeset
|
1670 |
{oracle = oracle, |
b1a87e3971a3
status_of: need to include local promises as well!
wenzelm
parents:
30711
diff
changeset
|
1671 |
unfinished = unfinished orelse exists is_none ps, |
b1a87e3971a3
status_of: need to include local promises as well!
wenzelm
parents:
30711
diff
changeset
|
1672 |
failed = failed orelse exists (fn SOME (Exn.Exn _) => true | _ => false) ps} |
b1a87e3971a3
status_of: need to include local promises as well!
wenzelm
parents:
30711
diff
changeset
|
1673 |
end; |
b1a87e3971a3
status_of: need to include local promises as well!
wenzelm
parents:
30711
diff
changeset
|
1674 |
|
29432
5bb5551bef03
added pending_groups -- accumulates task groups of local derivations only;
wenzelm
parents:
29288
diff
changeset
|
1675 |
|
5bb5551bef03
added pending_groups -- accumulates task groups of local derivations only;
wenzelm
parents:
29288
diff
changeset
|
1676 |
(* fulfilled proofs *) |
28330 | 1677 |
|
28996
01918abaa9e7
refined type deriv: replaced all_promises by max_promise (dependency limit) and open_promises (potentially unfinished/failed promises);
wenzelm
parents:
28992
diff
changeset
|
1678 |
fun proof_body_of (Thm (Deriv {open_promises, promises, body, ...}, {thy_ref, ...})) = |
28330 | 1679 |
let |
28996
01918abaa9e7
refined type deriv: replaced all_promises by max_promise (dependency limit) and open_promises (potentially unfinished/failed promises);
wenzelm
parents:
28992
diff
changeset
|
1680 |
val _ = Exn.release_all (map (Future.join_result o #2) (rev open_promises)); |
30717
465093aa5844
fulfill_proof/thm_proof: pass whole proof_body, not just the projection to proof (which might be incomplete);
wenzelm
parents:
30713
diff
changeset
|
1681 |
val ps = map (apsnd (raw_proof_body_of o Future.join)) promises; |
28829 | 1682 |
in Pt.fulfill_proof (Theory.deref thy_ref) ps body end; |
28804
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
1683 |
|
28814 | 1684 |
val proof_of = Proofterm.proof_of o proof_body_of; |
29003 | 1685 |
val join_proof = ignore o proof_body_of; |
28814 | 1686 |
|
28804
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
1687 |
|
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
1688 |
(* closed derivations with official name *) |
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
1689 |
|
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
1690 |
fun get_name thm = |
28814 | 1691 |
Pt.get_name (hyps_of thm) (prop_of thm) (raw_proof_of thm); |
28330 | 1692 |
|
28804
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
1693 |
fun put_name name (thm as Thm (der, args)) = |
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
1694 |
let |
28996
01918abaa9e7
refined type deriv: replaced all_promises by max_promise (dependency limit) and open_promises (potentially unfinished/failed promises);
wenzelm
parents:
28992
diff
changeset
|
1695 |
val Deriv {max_promise, open_promises, promises, body, ...} = der; |
28804
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
1696 |
val {thy_ref, hyps, prop, tpairs, ...} = args; |
28996
01918abaa9e7
refined type deriv: replaced all_promises by max_promise (dependency limit) and open_promises (potentially unfinished/failed promises);
wenzelm
parents:
28992
diff
changeset
|
1697 |
val _ = null tpairs orelse raise THM ("put_name: unsolved flex-flex constraints", 0, [thm]); |
28804
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
1698 |
|
30717
465093aa5844
fulfill_proof/thm_proof: pass whole proof_body, not just the projection to proof (which might be incomplete);
wenzelm
parents:
30713
diff
changeset
|
1699 |
val ps = map (apsnd (Future.map proof_body_of)) promises; |
28804
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
1700 |
val thy = Theory.deref thy_ref; |
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
1701 |
val (pthm, proof) = Pt.thm_proof thy name hyps prop ps body; |
28996
01918abaa9e7
refined type deriv: replaced all_promises by max_promise (dependency limit) and open_promises (potentially unfinished/failed promises);
wenzelm
parents:
28992
diff
changeset
|
1702 |
|
01918abaa9e7
refined type deriv: replaced all_promises by max_promise (dependency limit) and open_promises (potentially unfinished/failed promises);
wenzelm
parents:
28992
diff
changeset
|
1703 |
val open_promises' = open_promises |> filter (fn (_, p) => |
01918abaa9e7
refined type deriv: replaced all_promises by max_promise (dependency limit) and open_promises (potentially unfinished/failed promises);
wenzelm
parents:
28992
diff
changeset
|
1704 |
(case Future.peek p of SOME (Exn.Result _) => false | _ => true)); |
01918abaa9e7
refined type deriv: replaced all_promises by max_promise (dependency limit) and open_promises (potentially unfinished/failed promises);
wenzelm
parents:
28992
diff
changeset
|
1705 |
val der' = make_deriv max_promise open_promises' [] [] [pthm] proof; |
28804
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
1706 |
val _ = Theory.check_thy thy; |
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
1707 |
in Thm (der', args) end; |
28330 | 1708 |
|
28321
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1709 |
|
9f4499bf9384
type thm: fully internal derivation, no longer exported;
wenzelm
parents:
28290
diff
changeset
|
1710 |
|
2509 | 1711 |
(*** Oracles ***) |
1712 |
||
28290 | 1713 |
(* oracle rule *) |
1714 |
||
1715 |
fun invoke_oracle thy_ref1 name oracle arg = |
|
28624 | 1716 |
let val Cterm {thy_ref = thy_ref2, t = prop, T, maxidx, sorts} = oracle arg in |
28290 | 1717 |
if T <> propT then |
1718 |
raise THM ("Oracle's result must have type prop: " ^ name, 0, []) |
|
1719 |
else |
|
30717
465093aa5844
fulfill_proof/thm_proof: pass whole proof_body, not just the projection to proof (which might be incomplete);
wenzelm
parents:
30713
diff
changeset
|
1720 |
let val (ora, prf) = Pt.oracle_proof name prop in |
465093aa5844
fulfill_proof/thm_proof: pass whole proof_body, not just the projection to proof (which might be incomplete);
wenzelm
parents:
30713
diff
changeset
|
1721 |
Thm (make_deriv ~1 [] [] [ora] [] prf, |
28804
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
1722 |
{thy_ref = Theory.merge_refs (thy_ref1, thy_ref2), |
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
1723 |
tags = [], |
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
1724 |
maxidx = maxidx, |
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
1725 |
shyps = sorts, |
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
1726 |
hyps = [], |
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
1727 |
tpairs = [], |
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
1728 |
prop = prop}) |
5d3b1df16353
refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents:
28675
diff
changeset
|
1729 |
end |
3812 | 1730 |
end; |
1731 |
||
28290 | 1732 |
|
1733 |
(* authentic derivation names *) |
|
1734 |
||
1735 |
fun err_dup_ora dup = error ("Duplicate oracle: " ^ quote dup); |
|
1736 |
||
1737 |
structure Oracles = TheoryDataFun |
|
1738 |
( |
|
30288
a32700e45ab3
Thm.add_oracle interface: replaced old bstring by binding;
wenzelm
parents:
29636
diff
changeset
|
1739 |
type T = serial NameSpace.table; |
28290 | 1740 |
val empty = NameSpace.empty_table; |
1741 |
val copy = I; |
|
1742 |
val extend = I; |
|
29288 | 1743 |
fun merge _ oracles : T = NameSpace.merge_tables (op =) oracles |
28290 | 1744 |
handle Symtab.DUP dup => err_dup_ora dup; |
1745 |
); |
|
1746 |
||
1747 |
val extern_oracles = map #1 o NameSpace.extern_table o Oracles.get; |
|
1748 |
||
30288
a32700e45ab3
Thm.add_oracle interface: replaced old bstring by binding;
wenzelm
parents:
29636
diff
changeset
|
1749 |
fun add_oracle (b, oracle) thy = |
28290 | 1750 |
let |
1751 |
val naming = Sign.naming_of thy; |
|
30466 | 1752 |
val (name, tab') = NameSpace.define naming (b, serial ()) (Oracles.get thy) |
30288
a32700e45ab3
Thm.add_oracle interface: replaced old bstring by binding;
wenzelm
parents:
29636
diff
changeset
|
1753 |
handle Symtab.DUP _ => err_dup_ora (Binding.str_of b); |
a32700e45ab3
Thm.add_oracle interface: replaced old bstring by binding;
wenzelm
parents:
29636
diff
changeset
|
1754 |
val thy' = Oracles.put tab' thy; |
28290 | 1755 |
in ((name, invoke_oracle (Theory.check_thy thy') name oracle), thy') end; |
1756 |
||
0 | 1757 |
end; |
1503 | 1758 |
|
6089 | 1759 |
structure BasicThm: BASIC_THM = Thm; |
1760 |
open BasicThm; |