author | wenzelm |
Thu, 13 Jul 2000 11:39:22 +0200 | |
changeset 9293 | 3da2533e0a61 |
parent 8807 | 0046be1769f9 |
child 9468 | 9adbcf6375c1 |
permissions | -rw-r--r-- |
7674
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
1 |
(* Title: Pure/Isar/obtain.ML |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
2 |
ID: $Id$ |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
3 |
Author: Markus Wenzel, TU Muenchen |
8807 | 4 |
License: GPL (GNU GENERAL PUBLIC LICENSE) |
7674
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
5 |
|
8543 | 6 |
The 'obtain' language element -- generalized existence at the level of |
7 |
proof texts. |
|
7674
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
8 |
|
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
9 |
The common case: |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
10 |
|
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
11 |
<goal_facts> |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
12 |
have/show C |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
13 |
obtain a in P[a] <proof> == |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
14 |
|
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
15 |
<goal_facts> |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
16 |
have/show C |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
17 |
proof succeed |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
18 |
def thesis == C |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
19 |
presume that: !!a. P a ==> thesis |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
20 |
from goal_facts show thesis <proof> |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
21 |
next |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
22 |
fix a |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
23 |
assume P a |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
24 |
|
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
25 |
The general case: |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
26 |
|
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
27 |
<goal_facts> |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
28 |
have/show !!x. G x ==> C x |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
29 |
obtain a in P[a] <proof> == |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
30 |
|
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
31 |
<goal_facts> |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
32 |
have/show !!x. G x ==> C x |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
33 |
proof succeed |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
34 |
fix x |
8543 | 35 |
assume hyps: G x |
8094 | 36 |
def thesis == C x |
7674
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
37 |
presume that: !!a. P a ==> thesis |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
38 |
from goal_facts show thesis <proof> |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
39 |
next |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
40 |
fix a |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
41 |
assume P a |
8094 | 42 |
*) |
7674
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
43 |
|
8094 | 44 |
signature OBTAIN_DATA = |
45 |
sig |
|
46 |
val that_atts: Proof.context attribute list |
|
47 |
end; |
|
7674
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
48 |
|
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
49 |
signature OBTAIN = |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
50 |
sig |
8094 | 51 |
val obtain: ((string list * string option) * Comment.text) list |
52 |
* ((string * Args.src list * (string * (string list * string list)) list) |
|
53 |
* Comment.text) list -> ProofHistory.T -> ProofHistory.T |
|
54 |
val obtain_i: ((string list * typ option) * Comment.text) list |
|
55 |
* ((string * Proof.context attribute list * (term * (term list * term list)) list) |
|
56 |
* Comment.text) list -> ProofHistory.T -> ProofHistory.T |
|
7674
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
57 |
end; |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
58 |
|
8094 | 59 |
functor ObtainFun(Data: OBTAIN_DATA): OBTAIN = |
7674
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
60 |
struct |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
61 |
|
8094 | 62 |
|
63 |
(** obtain(_i) **) |
|
64 |
||
7674
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
65 |
val thatN = "that"; |
8543 | 66 |
val hypsN = "hyps"; |
7674
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
67 |
|
8094 | 68 |
fun gen_obtain prep_vars prep_propp prep_att (raw_vars, raw_asms) state = |
7674
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
69 |
let |
8543 | 70 |
val _ = Proof.assert_backward state; |
7674
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
71 |
|
8543 | 72 |
(*obtain vars*) |
8094 | 73 |
val (vars_ctxt, vars) = |
74 |
foldl_map prep_vars (Proof.context_of state, map Comment.ignore raw_vars); |
|
75 |
val xs = flat (map fst vars); |
|
9293 | 76 |
val xs_thesis = xs @ [AutoBind.thesisN]; |
77 |
||
78 |
val bind_skolem = ProofContext.bind_skolem vars_ctxt xs_thesis; |
|
79 |
fun bind_propp (prop, (pats1, pats2)) = |
|
80 |
(bind_skolem prop, (map bind_skolem pats1, map bind_skolem pats2)); |
|
7674
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
81 |
|
8543 | 82 |
(*obtain asms*) |
8094 | 83 |
fun prep_asm (ctxt, (name, src, raw_propps)) = |
84 |
let |
|
85 |
val atts = map (prep_att (ProofContext.theory_of ctxt)) src; |
|
86 |
val (ctxt', propps) = foldl_map prep_propp (ctxt, raw_propps); |
|
9293 | 87 |
in (ctxt', ((name, atts, map bind_propp propps), map #1 propps)) end; |
7674
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
88 |
|
9293 | 89 |
val (asms_ctxt, asms_result) = foldl_map prep_asm (vars_ctxt, map Comment.ignore raw_asms); |
90 |
val (asms, asm_propss) = Library.split_list asms_result; |
|
91 |
val asm_props = flat asm_propss; |
|
8094 | 92 |
val _ = ProofContext.warn_extra_tfrees vars_ctxt asms_ctxt; |
7674
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
93 |
|
8543 | 94 |
(*thesis*) |
9293 | 95 |
val (prop, (goal_facts, _)) = Proof.get_goal state; |
8543 | 96 |
|
97 |
val parms = Logic.strip_params prop; |
|
9293 | 98 |
val parm_names = Term.variantlist (map #1 parms, Term.add_term_names (prop, xs_thesis)); |
8543 | 99 |
val parm_types = map #2 parms; |
100 |
val parm_vars = map Library.single parm_names ~~ map Some parm_types; |
|
101 |
||
102 |
val frees = map2 Free (parm_names, parm_types); |
|
103 |
val rev_frees = rev frees; |
|
104 |
||
105 |
val hyps = map (fn t => Term.subst_bounds (rev_frees, t)) (Logic.strip_assums_hyp prop); |
|
106 |
val concl = Term.subst_bounds (rev_frees, Logic.strip_assums_concl prop); |
|
9293 | 107 |
val (thesis_term, atomic_thesis) = AutoBind.atomic_thesis concl; |
108 |
val bound_thesis = bind_skolem atomic_thesis; |
|
8543 | 109 |
|
8094 | 110 |
(*that_prop*) |
7674
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
111 |
fun find_free x t = |
8614 | 112 |
(case ProofContext.find_free t x of Some (Free a) => Some a | _ => None); |
8094 | 113 |
fun occs_var x = Library.get_first (find_free x) asm_props; |
7674
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
114 |
val that_prop = |
9293 | 115 |
Term.list_all_free (mapfilter occs_var xs, Logic.list_implies (asm_props, bound_thesis)); |
7674
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
116 |
|
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
117 |
fun after_qed st = |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
118 |
st |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
119 |
|> Proof.next_block |
8094 | 120 |
|> Proof.fix_i vars |
121 |
|> Proof.assume_i asms |
|
7674
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
122 |
|> Seq.single; |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
123 |
in |
8094 | 124 |
state |
125 |
|> Method.proof (Some (Method.Basic (K Method.succeed))) |
|
7674
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
126 |
|> Seq.map (fn st => st |
8543 | 127 |
|> Proof.fix_i parm_vars |
128 |
|> Proof.assume_i [(hypsN, [], map (rpair ([], [])) hyps)] |
|
9293 | 129 |
|> LocalDefs.def_i "" [] ((AutoBind.thesisN, None), (thesis_term, [])) |
8094 | 130 |
|> Proof.presume_i [(thatN, Data.that_atts, [(that_prop, ([], []))])] |
7674
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
131 |
|> Proof.from_facts goal_facts |
9293 | 132 |
|> Proof.show_i after_qed "" [] (bound_thesis, ([], []))) |
7674
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
133 |
end; |
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
134 |
|
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
135 |
|
8094 | 136 |
val obtain = ProofHistory.applys o |
137 |
(gen_obtain ProofContext.read_vars ProofContext.read_propp Attrib.local_attribute); |
|
138 |
||
139 |
val obtain_i = ProofHistory.applys o |
|
140 |
(gen_obtain ProofContext.cert_vars ProofContext.cert_propp (K I)); |
|
141 |
||
142 |
||
143 |
||
144 |
(** outer syntax **) |
|
145 |
||
146 |
local structure P = OuterParse and K = OuterSyntax.Keyword in |
|
147 |
||
148 |
val obtainP = |
|
8543 | 149 |
OuterSyntax.command "obtain" "generalized existence" |
8094 | 150 |
K.prf_asm_goal |
151 |
(Scan.optional |
|
152 |
(P.and_list1 (Scan.repeat1 P.name -- Scan.option (P.$$$ "::" |-- P.typ) -- P.marg_comment) |
|
8109 | 153 |
--| P.$$$ "where") [] -- |
8094 | 154 |
P.and_list1 ((P.opt_thm_name ":" -- Scan.repeat1 P.propp >> P.triple1) -- P.marg_comment) |
155 |
>> (Toplevel.print oo (Toplevel.proof o obtain))); |
|
156 |
||
8109 | 157 |
val _ = OuterSyntax.add_keywords ["where"]; |
8094 | 158 |
val _ = OuterSyntax.add_parsers [obtainP]; |
159 |
||
160 |
end; |
|
7674
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
161 |
|
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
162 |
|
99305245f6bd
The 'obtain' language element -- achieves (eliminated) existential
wenzelm
parents:
diff
changeset
|
163 |
end; |