74 end; |
74 end; |
75 |
75 |
76 functor Quantifier1Fun(Data: QUANTIFIER1_DATA): QUANTIFIER1 = |
76 functor Quantifier1Fun(Data: QUANTIFIER1_DATA): QUANTIFIER1 = |
77 struct |
77 struct |
78 |
78 |
79 open Data; |
|
80 |
|
81 (* FIXME: only test! *) |
79 (* FIXME: only test! *) |
82 fun def xs eq = |
80 fun def xs eq = |
83 (case dest_eq eq of |
81 (case Data.dest_eq eq of |
84 SOME(c,s,t) => |
82 SOME(c,s,t) => |
85 let val n = length xs |
83 let val n = length xs |
86 in s = Bound n andalso not(loose_bvar1(t,n)) orelse |
84 in s = Bound n andalso not(loose_bvar1(t,n)) orelse |
87 t = Bound n andalso not(loose_bvar1(s,n)) end |
85 t = Bound n andalso not(loose_bvar1(s,n)) end |
88 | NONE => false); |
86 | NONE => false); |
89 |
87 |
90 fun extract_conj fst xs t = case dest_conj t of NONE => NONE |
88 fun extract_conj fst xs t = case Data.dest_conj t of NONE => NONE |
91 | SOME(conj,P,Q) => |
89 | SOME(conj,P,Q) => |
92 (if def xs P then (if fst then NONE else SOME(xs,P,Q)) else |
90 (if def xs P then (if fst then NONE else SOME(xs,P,Q)) else |
93 if def xs Q then SOME(xs,Q,P) else |
91 if def xs Q then SOME(xs,Q,P) else |
94 (case extract_conj false xs P of |
92 (case extract_conj false xs P of |
95 SOME(xs,eq,P') => SOME(xs,eq, conj $ P' $ Q) |
93 SOME(xs,eq,P') => SOME(xs,eq, Data.conj $ P' $ Q) |
96 | NONE => (case extract_conj false xs Q of |
94 | NONE => (case extract_conj false xs Q of |
97 SOME(xs,eq,Q') => SOME(xs,eq,conj $ P $ Q') |
95 SOME(xs,eq,Q') => SOME(xs,eq,Data.conj $ P $ Q') |
98 | NONE => NONE))); |
96 | NONE => NONE))); |
99 |
97 |
100 fun extract_imp fst xs t = case dest_imp t of NONE => NONE |
98 fun extract_imp fst xs t = case Data.dest_imp t of NONE => NONE |
101 | SOME(imp,P,Q) => if def xs P then (if fst then NONE else SOME(xs,P,Q)) |
99 | SOME(imp,P,Q) => if def xs P then (if fst then NONE else SOME(xs,P,Q)) |
102 else (case extract_conj false xs P of |
100 else (case extract_conj false xs P of |
103 SOME(xs,eq,P') => SOME(xs, eq, imp $ P' $ Q) |
101 SOME(xs,eq,P') => SOME(xs, eq, Data.imp $ P' $ Q) |
104 | NONE => (case extract_imp false xs Q of |
102 | NONE => (case extract_imp false xs Q of |
105 NONE => NONE |
103 NONE => NONE |
106 | SOME(xs,eq,Q') => |
104 | SOME(xs,eq,Q') => |
107 SOME(xs,eq,imp$P$Q'))); |
105 SOME(xs,eq,Data.imp$P$Q'))); |
108 |
106 |
109 fun extract_quant extract q = |
107 fun extract_quant extract q = |
110 let fun exqu xs ((qC as Const(qa,_)) $ Abs(x,T,Q)) = |
108 let fun exqu xs ((qC as Const(qa,_)) $ Abs(x,T,Q)) = |
111 if qa = q then exqu ((qC,x,T)::xs) Q else NONE |
109 if qa = q then exqu ((qC,x,T)::xs) Q else NONE |
112 | exqu xs P = extract (null xs) xs P |
110 | exqu xs P = extract (null xs) xs P |
116 let |
114 let |
117 val ctxt = Simplifier.the_context ss; |
115 val ctxt = Simplifier.the_context ss; |
118 val (goal, ctxt') = |
116 val (goal, ctxt') = |
119 yield_singleton (Variable.import_terms true) (Logic.mk_equals tu) ctxt; |
117 yield_singleton (Variable.import_terms true) (Logic.mk_equals tu) ctxt; |
120 val thm = |
118 val thm = |
121 Goal.prove ctxt' [] [] goal (K (rtac iff_reflection 1 THEN tac)); |
119 Goal.prove ctxt' [] [] goal (K (rtac Data.iff_reflection 1 THEN tac)); |
122 in singleton (Variable.export ctxt' ctxt) thm end; |
120 in singleton (Variable.export ctxt' ctxt) thm end; |
123 |
121 |
124 fun qcomm_tac qcomm qI i = REPEAT_DETERM (rtac qcomm i THEN rtac qI i) |
122 fun qcomm_tac qcomm qI i = REPEAT_DETERM (rtac qcomm i THEN rtac qI i) |
125 |
123 |
126 (* Proves (? x0..xn. ... & x0 = t & ...) = (? x1..xn x0. x0 = t & ... & ...) |
124 (* Proves (? x0..xn. ... & x0 = t & ...) = (? x1..xn x0. x0 = t & ... & ...) |
127 Better: instantiate exI |
125 Better: instantiate exI |
128 *) |
126 *) |
129 local |
127 local |
130 val excomm = ex_comm RS iff_trans |
128 val excomm = Data.ex_comm RS Data.iff_trans |
131 in |
129 in |
132 val prove_one_point_ex_tac = qcomm_tac excomm iff_exI 1 THEN rtac iffI 1 THEN |
130 val prove_one_point_ex_tac = qcomm_tac excomm Data.iff_exI 1 THEN rtac Data.iffI 1 THEN |
133 ALLGOALS(EVERY'[etac exE, REPEAT_DETERM o (etac conjE), rtac exI, |
131 ALLGOALS(EVERY'[etac Data.exE, REPEAT_DETERM o (etac Data.conjE), rtac Data.exI, |
134 DEPTH_SOLVE_1 o (ares_tac [conjI])]) |
132 DEPTH_SOLVE_1 o (ares_tac [Data.conjI])]) |
135 end; |
133 end; |
136 |
134 |
137 (* Proves (! x0..xn. (... & x0 = t & ...) --> P x0) = |
135 (* Proves (! x0..xn. (... & x0 = t & ...) --> P x0) = |
138 (! x1..xn x0. x0 = t --> (... & ...) --> P x0) |
136 (! x1..xn x0. x0 = t --> (... & ...) --> P x0) |
139 *) |
137 *) |
140 local |
138 local |
141 val tac = SELECT_GOAL |
139 val tac = SELECT_GOAL |
142 (EVERY1[REPEAT o (dtac uncurry), REPEAT o (rtac impI), etac mp, |
140 (EVERY1[REPEAT o (dtac Data.uncurry), REPEAT o (rtac Data.impI), etac Data.mp, |
143 REPEAT o (etac conjE), REPEAT o (ares_tac [conjI])]) |
141 REPEAT o (etac Data.conjE), REPEAT o (ares_tac [Data.conjI])]) |
144 val allcomm = all_comm RS iff_trans |
142 val allcomm = Data.all_comm RS Data.iff_trans |
145 in |
143 in |
146 val prove_one_point_all_tac = |
144 val prove_one_point_all_tac = |
147 EVERY1[qcomm_tac allcomm iff_allI,rtac iff_allI, rtac iffI, tac, tac] |
145 EVERY1[qcomm_tac allcomm Data.iff_allI,rtac Data.iff_allI, rtac Data.iffI, tac, tac] |
148 end |
146 end |
149 |
147 |
150 fun renumber l u (Bound i) = Bound(if i < l orelse i > u then i else |
148 fun renumber l u (Bound i) = Bound(if i < l orelse i > u then i else |
151 if i=u then l else i+1) |
149 if i=u then l else i+1) |
152 | renumber l u (s$t) = renumber l u s $ renumber l u t |
150 | renumber l u (s$t) = renumber l u s $ renumber l u t |
162 |
160 |
163 fun rearrange_all ss (F as (all as Const(q,_)) $ Abs(x,T, P)) = |
161 fun rearrange_all ss (F as (all as Const(q,_)) $ Abs(x,T, P)) = |
164 (case extract_quant extract_imp q P of |
162 (case extract_quant extract_imp q P of |
165 NONE => NONE |
163 NONE => NONE |
166 | SOME(xs,eq,Q) => |
164 | SOME(xs,eq,Q) => |
167 let val R = quantify all x T xs (imp $ eq $ Q) |
165 let val R = quantify all x T xs (Data.imp $ eq $ Q) |
168 in SOME (prove_conv prove_one_point_all_tac ss (F,R)) end) |
166 in SOME (prove_conv prove_one_point_all_tac ss (F,R)) end) |
169 | rearrange_all _ _ = NONE; |
167 | rearrange_all _ _ = NONE; |
170 |
168 |
171 fun rearrange_ball tac ss (F as Ball $ A $ Abs(x,T,P)) = |
169 fun rearrange_ball tac ss (F as Ball $ A $ Abs(x,T,P)) = |
172 (case extract_imp true [] P of |
170 (case extract_imp true [] P of |
173 NONE => NONE |
171 NONE => NONE |
174 | SOME(xs,eq,Q) => if not(null xs) then NONE else |
172 | SOME(xs,eq,Q) => if not(null xs) then NONE else |
175 let val R = imp $ eq $ Q |
173 let val R = Data.imp $ eq $ Q |
176 in SOME (prove_conv tac ss (F,Ball $ A $ Abs(x,T,R))) end) |
174 in SOME (prove_conv tac ss (F,Ball $ A $ Abs(x,T,R))) end) |
177 | rearrange_ball _ _ _ = NONE; |
175 | rearrange_ball _ _ _ = NONE; |
178 |
176 |
179 fun rearrange_ex ss (F as (ex as Const(q,_)) $ Abs(x,T,P)) = |
177 fun rearrange_ex ss (F as (ex as Const(q,_)) $ Abs(x,T,P)) = |
180 (case extract_quant extract_conj q P of |
178 (case extract_quant extract_conj q P of |
181 NONE => NONE |
179 NONE => NONE |
182 | SOME(xs,eq,Q) => |
180 | SOME(xs,eq,Q) => |
183 let val R = quantify ex x T xs (conj $ eq $ Q) |
181 let val R = quantify ex x T xs (Data.conj $ eq $ Q) |
184 in SOME(prove_conv prove_one_point_ex_tac ss (F,R)) end) |
182 in SOME(prove_conv prove_one_point_ex_tac ss (F,R)) end) |
185 | rearrange_ex _ _ = NONE; |
183 | rearrange_ex _ _ = NONE; |
186 |
184 |
187 fun rearrange_bex tac ss (F as Bex $ A $ Abs(x,T,P)) = |
185 fun rearrange_bex tac ss (F as Bex $ A $ Abs(x,T,P)) = |
188 (case extract_conj true [] P of |
186 (case extract_conj true [] P of |
189 NONE => NONE |
187 NONE => NONE |
190 | SOME(xs,eq,Q) => if not(null xs) then NONE else |
188 | SOME(xs,eq,Q) => if not(null xs) then NONE else |
191 SOME(prove_conv tac ss (F,Bex $ A $ Abs(x,T,conj$eq$Q)))) |
189 SOME(prove_conv tac ss (F,Bex $ A $ Abs(x,T,Data.conj$eq$Q)))) |
192 | rearrange_bex _ _ _ = NONE; |
190 | rearrange_bex _ _ _ = NONE; |
193 |
191 |
194 fun rearrange_Collect tac ss (F as Coll $ Abs(x,T,P)) = |
192 fun rearrange_Collect tac ss (F as Coll $ Abs(x,T,P)) = |
195 (case extract_conj true [] P of |
193 (case extract_conj true [] P of |
196 NONE => NONE |
194 NONE => NONE |
197 | SOME(_,eq,Q) => |
195 | SOME(_,eq,Q) => |
198 let val R = Coll $ Abs(x,T, conj $ eq $ Q) |
196 let val R = Coll $ Abs(x,T, Data.conj $ eq $ Q) |
199 in SOME(prove_conv tac ss (F,R)) end); |
197 in SOME(prove_conv tac ss (F,R)) end); |
200 |
198 |
201 end; |
199 end; |