4 12345678901234567890123456789012345678901234567890123456789012345678901234567890
5 10 20 30 40 50 60 70 80
7 val e_cterm' = empty_cterm';
10 fun rew_info (Rls {erls,rew_ord=(rew_ord',_),calc=ca, ...}) =
11 (rew_ord':rew_ord',erls,ca)
12 | rew_info (Seq {erls,rew_ord=(rew_ord',_),calc=ca, ...}) =
14 | rew_info (Rrls {erls,rew_ord=(rew_ord',_),calc=ca, ...}) =
16 | rew_info rls = error ("rew_info called with '"^rls2str rls^"'");
18 (*FIXME.3.4.03:re-organize from_pblobj_or_detail_thm after rls' --> rls*)
19 fun from_pblobj_or_detail_thm thm' p pt =
21 val (pbl, p', rls') = par_pbl_det pt p
26 val thy' = get_obj g_domID pt p'
27 val {rew_ord', erls, ...} = Specify.get_met (get_obj g_metID pt p')
28 in ("OK", thy', rew_ord', erls, false) end
31 val thy' = get_obj g_domID pt (par_pblobj pt p)
32 val (rew_ord', erls, _) = rew_info rls'
33 in ("OK",thy',rew_ord',erls,false) end
35 (*FIXME.3.4.03:re-organize from_pblobj_or_detail_calc after rls' --> rls*)
36 fun from_pblobj_or_detail_calc scrop p pt =
38 val (pbl,p',rls') = par_pbl_det pt p
43 val thy' = get_obj g_domID pt p'
44 val {calc = scr_isa_fns,...} = Specify.get_met (get_obj g_metID pt p')
45 val opt = assoc (scr_isa_fns, scrop)
48 SOME isa_fn => ("OK",thy',isa_fn)
49 | NONE => ("applicable_in Calculate: unknown '" ^ scrop ^ "'", "", ("", e_evalfn))
53 val thy' = get_obj g_domID pt (par_pblobj pt p);
54 val (_,_,(*_,*)scr_isa_fns) = rew_info rls'(*rls*)
56 case assoc (scr_isa_fns, scrop) of
57 SOME isa_fn => ("OK",thy',isa_fn)
58 | NONE => ("applicable_in Calculate: unknown '" ^ scrop ^ "'", "", ("", e_evalfn))
62 val op_and = Const ("op &", [bool, bool] ---> bool);
63 (*> (Thm.global_cterm_of thy) (op_and $ Free("a",bool) $ Free("b",bool));
64 val it = "a & b" : cterm
66 fun mk_and a b = op_and $ a $ b;
67 (*> (Thm.global_cterm_of thy)
68 (mk_and (Free("a",bool)) (Free("b",bool)));
69 val it = "a & b" : cterm*)
71 fun mk_and [] = @{term True}
74 let fun mk t' (t::[]) = op_and $ t' $ t
75 | mk t' (t::ts) = mk (op_and $ t' $ t) ts
77 (*> val pred = map (Thm.term_of o the o (parse thy))
78 ["#0 <= #9 + #4 * x","#0 <= sqrt x + sqrt (#-3 + x)"];
79 > (Thm.global_cterm_of thy) (mk_and pred);
80 val it = "#0 <= #9 + #4 * x & #0 <= sqrt x + sqrt (#-3 + x)" : cterm*)
85 (*for Check_elementwise in applicable_in: [x=1,..] Assumptions -> (x,0<=x&..)*)
86 fun mk_set thy pt p (Const ("List.list.Nil",_)) pred = (e_term, [])
88 | mk_set thy pt p (Const ("Tools.UniversalList",_)) pred =
89 (e_term, if pred <> Const ("Script.Assumptions",bool)
91 else get_assumptions_ pt (p,Res))
93 (* val pred = (Thm.term_of o the o (parse thy)) pred;
94 val consts as Const ("List.list.Cons",_) $ eq $ _ = ft;
95 mk_set thy pt p consts pred;
97 | mk_set thy pt p (consts as Const ("List.list.Cons",_) $ eq $ _) pred =
98 let val (bdv,_) = HOLogic.dest_eq eq;
99 val pred = if pred <> Const ("Script.Assumptions",bool)
101 else get_assumptions_ pt (p,Res)
104 | mk_set thy _ _ l _ =
105 error ("check_elementwise: no set " ^ term2str l);
106 (*> val consts = str2term "[x=#4]";
107 > val pred = str2term "Assumptions";
108 > val pt = union_asm pt p
109 [("#0 <= sqrt x + sqrt (#5 + x)",[11]),("#0 <= #9 + #4 * x",[22]),
110 ("#0 <= x ^^^ #2 + #5 * x",[33]),("#0 <= #2 + x",[44])];
112 > val (sss,ttt) = mk_set thy pt p consts pred;
113 > (term2str sss, term2str ttt);
114 val it = ("x","((#0 <= sqrt x + sqrt (#5 + x) & #0 <= #9 + #4 * x) & ...
116 val consts = str2term "UniversalList";
117 val pred = str2term "Assumptions";
123 (*check a list (/set) of constants [c_1,..,c_n] for c_i:set (: in)*)
124 (* val (erls,consts,(bdv,pred)) = (erl,ft,vp);
125 val (consts,(bdv,pred)) = (ft,vp);
127 fun check_elementwise thy erls all_results (bdv, asm) =
128 let (*bdv extracted from ~~~~~~~~~~~ in mk_set already*)
130 let val inst_ = map (subst_atomic [sub]) asm
131 in case eval__true thy 1 inst_ [] erls of
132 (asm', true) => ([HOLogic.mk_eq sub], asm')
133 | (_, false) => ([],[])
135 (*val _= tracing("### check_elementwise: res= "^(term2str all_results)^
136 ", bdv= "^(term2str bdv)^", asm= "^(terms2str asm));*)
137 val c' = isalist2list all_results
138 val c'' = map (snd o HOLogic.dest_eq) c' (*assumes [x=1,x=2,..]*)
139 val subs = map (pair bdv) c''
140 in if asm = [] then (all_results, [])
141 else ((apfst ((list2isalist bool) o flat)) o
142 (apsnd flat) o split_list o (map check)) subs end;
144 > val all_results = str2term "[x=a+b,x=b,x=3]";
145 > val bdv = str2term "x";
146 > val asm = str2term "(x ~= a) & (x ~= b)";
148 > val (t, ts) = check_elementwise thy erls all_results (bdv, asm);
149 > term2str t; tracing(terms2str ts);
150 val it = "[x = a + b, x = b, x = c]" : string
151 ["a + b ~= a & a + b ~= b","b ~= a & b ~= b","c ~= a & c ~= b"]
152 ... with appropriate erls this should be:
153 val it = "[x = a + b, x = c]" : string
154 ["b ~= 0 & a ~= 0", "3 ~= a & 3 ~= b"]
155 ////// because b ~= b False*)
160 > val ct = "((#0 <= #18 & #0 <= sqrt (#5 + #3) + sqrt (#5 - #3)) &\
161 \ #0 <= #25 + #-1 * #3 ^^^ #2) & #0 <= #4";
162 > val SOME(ct',_) = rewrite_set "Isac" false "eval_rls" ct;
163 val ct' = "HOL.True" : cterm'
165 > val ct = "((#0 <= #18 & #0 <= sqrt (#5 + #-3) + sqrt (#5 - #-3)) &\
166 \ #0 <= #25 + #-1 * #-3 ^^^ #2) & #0 <= #4";
167 > val SOME(ct',_) = rewrite_set "Isac" false "eval_rls" ct;
168 val ct' = "HOL.True" : cterm'
171 > val const = (Thm.term_of o the o (parse thy)) "(#3::real)";
172 > val pred' = subst_atomic [(bdv,const)] pred;
175 > val consts = (Thm.term_of o the o (parse thy)) "[x = #-3, x = #3]";
176 > val bdv = (Thm.term_of o the o (parse thy)) "(x::real)";
177 > val pred = (Thm.term_of o the o (parse thy))
178 "((#0 <= #18 & #0 <= sqrt (#5 + x) + sqrt (#5 - x)) & #0 <= #25 + #-1 * x ^^^ #2) & #0 <= #4";
179 > val ttt = check_elementwise thy consts (bdv, pred);
180 > (Thm.global_cterm_of thy) ttt;
181 val it = "[x = #-3, x = #3]" : cterm
183 > val consts = (Thm.term_of o the o (parse thy)) "[x = #4]";
184 > val bdv = (Thm.term_of o the o (parse thy)) "(x::real)";
185 > val pred = (Thm.term_of o the o (parse thy))
186 "#0 <= sqrt x + sqrt (#5 + x) & #0 <= #9 + #4 * x & #0 <= x ^^^ #2 + #5 * x & #0 <= #2 + x";
187 > val ttt = check_elementwise thy consts (bdv,pred);
188 > (Thm.global_cterm_of thy) ttt;
189 val it = "[x = #4]" : cterm
191 > val consts = (Thm.term_of o the o (parse thy)) "[x = #-12 // #5]";
192 > val bdv = (Thm.term_of o the o (parse thy)) "(x::real)";
193 > val pred = (Thm.term_of o the o (parse thy))
194 " #0 <= sqrt x + sqrt (#-3 + x) & #0 <= #9 + #4 * x & #0 <= x ^^^ #2 + #-3 * x & #0 <= #6 + x";
195 > val ttt = check_elementwise thy consts (bdv,pred);
196 > (Thm.global_cterm_of thy) ttt;
197 val it = "[]" : cterm*)
200 (* 14.1.01: for Tac-dummies in root-equ only: skip str until "("*)
201 fun split_dummy str =
202 let fun scan s' [] = (implode s', "")
203 | scan s' (s::ss) = if s=" " then (implode s', implode ss)
204 else scan (s'@[s]) ss;
205 in ((scan []) o Symbol.explode) str end;
206 (* split_dummy "subproblem_equation_dummy (x=-#5//#12)";
207 val it = ("subproblem_equation_dummy","(x=-#5//#12)") : string * string
208 > split_dummy "x=-#5//#12";
209 val it = ("x=-#5//#12","") : string * string*)
214 (*.applicability of a tacic wrt. a calc-state (ptree,pos').
215 additionally used by next_tac in the script-interpreter for script-tacs.
216 tests for applicability are so expensive, that results (rewrites!)
217 are kept in the return-value of 'type tac_'.
219 fun applicable_in (_:pos') _ (Init_Proof (ct', spec)) = Chead.Appl (Init_Proof' (ct', spec))
221 | applicable_in (p,p_) pt Model_Problem =
222 if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
223 then Chead.Notappl ((tac2str Model_Problem) ^ " not for pos " ^ (pos'2str (p,p_)))
226 val (PblObj{origin=(_,(_,pI',_),_),...}) = get_obj I pt p
227 val {ppc,...} = Specify.get_pbt pI'
228 val pbl = Generate.init_pbl ppc
229 in Chead.Appl (Model_Problem' (pI', pbl, [])) end
231 | applicable_in (p,p_) pt (Refine_Tacitly pI) =
232 if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
233 then Chead.Notappl ((tac2str (Refine_Tacitly pI)) ^ " not for pos " ^ (pos'2str (p,p_)))
236 val (PblObj {origin = (oris, (dI',_,_),_), ...}) = get_obj I pt p;
237 val opt = Specify.refine_ori oris pI;
240 Chead.Appl (Refine_Tacitly' (pI, pblID,
241 e_domID, e_metID, [](*filled in specify*)))
242 | NONE => Chead.Notappl ((tac2str (Refine_Tacitly pI)) ^ " not applicable")
245 | applicable_in (p,p_) pt (Refine_Problem pI) =
246 if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
247 then Chead.Notappl ((tac2str (Refine_Problem pI))^
248 " not for pos "^(pos'2str (p,p_)))
250 let val (PblObj {origin=(_,(dI,_,_),_),spec=(dI',_,_),
251 probl=itms, ...}) = get_obj I pt p;
252 val thy = if dI' = e_domID then dI else dI';
253 val rfopt = Specify.refine_pbl (assoc_thy thy) pI itms;
255 NONE => Chead.Notappl ((tac2str (Refine_Problem pI))^" not applicable")
256 | SOME (rf as (pI',_)) =>
258 then Chead.Notappl ((tac2str (Refine_Problem pI))^" not applicable")
259 else Chead.Appl (Refine_Problem' rf)
262 (*the specify-tacs have cterm' instead term:
263 parse+error here!!!: see appl_add*)
264 | applicable_in (p,p_) pt (Add_Given ct') =
265 if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
266 then Chead.Notappl ((tac2str (Add_Given ct'))^
267 " not for pos "^(pos'2str (p,p_)))
268 else Chead.Appl (Add_Given' (ct', [(*filled in specify_additem*)]))
269 (*Add_.. should reject (dsc //) (see fmz=[] in sqrt*)
271 | applicable_in (p,p_) pt (Del_Given ct') =
272 if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
273 then Chead.Notappl ((tac2str (Del_Given ct'))^
274 " not for pos "^(pos'2str (p,p_)))
275 else Chead.Appl (Del_Given' ct')
277 | applicable_in (p,p_) pt (Add_Find ct') =
278 if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
279 then Chead.Notappl ((tac2str (Add_Find ct'))^
280 " not for pos "^(pos'2str (p,p_)))
281 else Chead.Appl (Add_Find' (ct', [(*filled in specify_additem*)]))
283 | applicable_in (p,p_) pt (Del_Find ct') =
284 if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
285 then Chead.Notappl ((tac2str (Del_Find ct'))^
286 " not for pos "^(pos'2str (p,p_)))
287 else Chead.Appl (Del_Find' ct')
289 | applicable_in (p,p_) pt (Add_Relation ct') =
290 if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
291 then Chead.Notappl ((tac2str (Add_Relation ct'))^
292 " not for pos "^(pos'2str (p,p_)))
293 else Chead.Appl (Add_Relation' (ct', [(*filled in specify_additem*)]))
295 | applicable_in (p,p_) pt (Del_Relation ct') =
296 if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
297 then Chead.Notappl ((tac2str (Del_Relation ct'))^
298 " not for pos "^(pos'2str (p,p_)))
299 else Chead.Appl (Del_Relation' ct')
301 | applicable_in (p,p_) pt (Specify_Theory dI) =
302 if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
303 then Chead.Notappl ((tac2str (Specify_Theory dI))^
304 " not for pos "^(pos'2str (p,p_)))
305 else Chead.Appl (Specify_Theory' dI)
306 (* val (p,p_) = p; val Specify_Problem pID = m;
307 val Specify_Problem pID = m;
309 | applicable_in (p,p_) pt (Specify_Problem pID) =
310 if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
311 then Chead.Notappl ((tac2str (Specify_Problem pID))^
312 " not for pos "^(pos'2str (p,p_)))
314 let val (PblObj {origin=(oris,(dI,pI,_),_),spec=(dI',pI',_),
315 probl=itms, ...}) = get_obj I pt p;
316 val thy = assoc_thy (if dI' = e_domID then dI else dI');
317 val {ppc,where_,prls,...} = Specify.get_pbt pID;
318 val pbl = if pI'=e_pblID andalso pI=e_pblID
319 then (false, (Generate.init_pbl ppc, []))
320 else Specify.match_itms_oris thy itms (ppc,where_,prls) oris;
321 in Chead.Appl (Specify_Problem' (pID, pbl)) end
322 (* val Specify_Method mID = nxt; val (p,p_) = p;
324 | applicable_in (p,p_) pt (Specify_Method mID) =
325 if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
326 then Chead.Notappl ((tac2str (Specify_Method mID))^
327 " not for pos "^(pos'2str (p,p_)))
328 else Chead.Appl (Specify_Method' (mID,[(*filled in specify*)],
329 [(*filled in specify*)]))
331 | applicable_in (p,p_) pt (Apply_Method mI) =
332 if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
333 then Chead.Notappl ((tac2str (Apply_Method mI)) ^ " not for pos " ^ (pos'2str (p,p_)))
336 val (PblObj{origin = (_, (dI, pI, _), _), probl, ctxt, ...}) = get_obj I pt p;
337 val {where_, ...} = Specify.get_pbt pI
338 val pres = map (mk_env probl |> subst_atomic) where_
341 then assoc_thy dI |> Proof_Context.init_global |> insert_assumptions pres
343 (*TODO.WN110416 here do evalprecond according to fun check_preconds'
344 and then decide on Chead.Notappl/Appl accordingly once more.
345 Implement after all tests are running, since this changes
346 overall system behavior*)
347 in Chead.Appl (Apply_Method' (mI, NONE, e_istate (*filled in solve*), ctxt)) end
349 | applicable_in (p,p_) pt (Check_Postcond pI) =
350 if member op = [Pbl,Met] p_
351 then Chead.Notappl ((tac2str (Check_Postcond pI)) ^ " not for pos "^(pos'2str (p,p_)))
352 else Chead.Appl (Check_Postcond' (pI, (e_term, [(*fun solve assignes the returnvalue of scr*)])))
354 (*these are always applicable*)
355 | applicable_in (p,p_) _ (Take str) = Chead.Appl (Take' (str2term str))
356 | applicable_in (p,p_) _ (Free_Solve) = Chead.Appl (Free_Solve')
358 | applicable_in (p, p_) pt (m as Rewrite_Inst (subs, thm'')) =
359 if member op = [Pbl, Met] p_
360 then Chead.Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
363 val pp = par_pblobj pt p;
364 val thy' = (get_obj g_domID pt pp): theory';
365 val thy = assoc_thy thy';
366 val {rew_ord' = ro', erls = erls, ...} = Specify.get_met (get_obj g_metID pt pp);
367 val (f, p) = case p_ of (*p 12.4.00 unnecessary*)
368 Frm => (get_obj g_form pt p, p)
369 | Res => ((fst o (get_obj g_result pt)) p, lev_on p)
370 | _ => error ("applicable_in: call by " ^ pos'2str (p,p_));
373 val subst = subs2subst thy subs;
374 val subs' = subst2subs' subst;
375 in case rewrite_inst_ thy (assoc_rew_ord ro') erls false subst (snd thm'') f of
377 Chead.Appl (Rewrite_Inst' (thy', ro', erls, false, subst, thm'', f, (f', asm)))
378 | NONE => Chead.Notappl ((fst thm'')^" not applicable")
380 handle _ => Chead.Notappl ("syntax error in "^(subs2str subs))
383 | applicable_in (p,p_) pt (m as Rewrite thm'') =
384 if member op = [Pbl,Met] p_
385 then Chead.Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
387 let val (msg,thy',ro,rls',(*put_asm*)_)= from_pblobj_or_detail_thm thm'' p pt;
388 val thy = assoc_thy thy';
390 Frm => get_obj g_form pt p
391 | Res => (fst o (get_obj g_result pt)) p
392 | _ => error ("applicable_in Rewrite: call by "^
396 case rewrite_ thy (assoc_rew_ord ro) rls' false (snd thm'') f of
397 SOME (f',asm) => Chead.Appl (Rewrite' (thy', ro, rls', false, thm'', f, (f', asm)))
398 | NONE => Chead.Notappl ("'" ^ fst thm'' ^"' not applicable")
399 else Chead.Notappl msg
402 | applicable_in (p,p_) pt (m as Rewrite_Asm thm'') =
403 if member op = [Pbl,Met] p_
404 then Chead.Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
407 val pp = par_pblobj pt p;
408 val thy' = (get_obj g_domID pt pp):theory';
409 val thy = assoc_thy thy';
410 val {rew_ord'=ro',erls=erls,...} = Specify.get_met (get_obj g_metID pt pp);
411 (*val put_asm = true;*)
412 val (f, _) = case p_ of
413 Frm => (get_obj g_form pt p, p)
414 | Res => ((fst o (get_obj g_result pt)) p, lev_on p)
415 | _ => error ("applicable_in: call by "^
417 in case rewrite_ thy (assoc_rew_ord ro') erls false (snd thm'') f of
418 SOME (f',asm) => Chead.Appl (
419 Rewrite' (thy', ro', erls, false, thm'', f, (f', asm)))
420 | NONE => Chead.Notappl ("'" ^ fst thm'' ^ "' not applicable") end
422 | applicable_in (p,p_) pt (m as Detail_Set_Inst (subs, rls)) =
423 if member op = [Pbl,Met] p_
424 then Chead.Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
427 val pp = par_pblobj pt p;
428 val thy' = (get_obj g_domID pt pp):theory';
429 val thy = assoc_thy thy';
430 val {rew_ord'=ro',...} = Specify.get_met (get_obj g_metID pt pp);
431 val f = case p_ of Frm => get_obj g_form pt p
432 | Res => (fst o (get_obj g_result pt)) p
433 | _ => error ("applicable_in: call by "^
436 let val subst = subs2subst thy subs
437 val subs' = subst2subs' subst
438 in case rewrite_set_inst_ thy false subst (assoc_rls rls) f of
439 SOME (f',asm) => Chead.Appl (
440 Detail_Set_Inst' (thy',false,subst,assoc_rls rls, f, (f', asm)))
441 | NONE => Chead.Notappl (rls^" not applicable") end
442 handle _ => Chead.Notappl ("syntax error in "^(subs2str subs)) end
444 | applicable_in (p,p_) pt (m as Rewrite_Set_Inst (subs, rls)) =
445 if member op = [Pbl,Met] p_
446 then Chead.Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
449 val pp = par_pblobj pt p;
450 val thy' = (get_obj g_domID pt pp):theory';
451 val thy = assoc_thy thy';
452 val {rew_ord'=ro',(*asm_rls=asm_rls,*)...} = Specify.get_met (get_obj g_metID pt pp);
453 val (f,p) = case p_ of (*p 12.4.00 unnecessary*)
454 Frm => (get_obj g_form pt p, p)
455 | Res => ((fst o (get_obj g_result pt)) p, lev_on p)
456 | _ => error ("applicable_in: call by "^
459 let val subst = subs2subst thy subs;
460 val subs' = subst2subs' subst;
461 in case rewrite_set_inst_ thy (*put_asm*)false subst (assoc_rls rls) f of
462 SOME (f',asm) => Chead.Appl (
463 Rewrite_Set_Inst' (thy',(*put_asm*)false,subst,assoc_rls rls, f, (f', asm)))
464 | NONE => Chead.Notappl (rls^" not applicable") end
465 handle _ => Chead.Notappl ("syntax error in "^(subs2str subs)) end
467 | applicable_in (p,p_) pt (m as Rewrite_Set rls) =
468 if member op = [Pbl,Met] p_
469 then Chead.Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
472 val pp = par_pblobj pt p;
473 val thy' = (get_obj g_domID pt pp):theory';
474 val (f,p) = case p_ of (*p 12.4.00 unnecessary*)
475 Frm => (get_obj g_form pt p, p)
476 | Res => ((fst o (get_obj g_result pt)) p, lev_on p)
477 | _ => error ("applicable_in: call by "^
479 in case rewrite_set_ (assoc_thy thy') false (assoc_rls rls) f of
481 ((*tracing("#.# applicable_in Rewrite_Set,2f'= "^f');*)
482 Chead.Appl (Rewrite_Set' (thy',(*put_asm*)false,assoc_rls rls, f, (f', asm)))
484 | NONE => Chead.Notappl (rls^" not applicable") end
486 | applicable_in (p,p_) pt (m as Detail_Set rls) =
487 if member op = [Pbl,Met] p_
488 then Chead.Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
490 let val pp = par_pblobj pt p
491 val thy' = (get_obj g_domID pt pp):theory'
493 Frm => get_obj g_form pt p
494 | Res => (fst o (get_obj g_result pt)) p
495 | _ => error ("applicable_in: call by "^
497 in case rewrite_set_ (assoc_thy thy') false (assoc_rls rls) f of
499 Chead.Appl (Detail_Set' (thy',false,assoc_rls rls, f, (f',asm)))
500 | NONE => Chead.Notappl (rls^" not applicable") end
503 | applicable_in p pt (End_Ruleset) =
504 error ("applicable_in: not impl. for "^
505 (tac2str End_Ruleset))
507 (* val ((p,p_), pt, (m as Calculate op_)) = (p, pt, m);
509 | applicable_in (p,p_) pt (m as Calculate op_) =
510 if member op = [Pbl,Met] p_
511 then Chead.Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
514 val (msg,thy',isa_fn) = from_pblobj_or_detail_calc op_ p pt;
516 Frm => get_obj g_form pt p
517 | Res => (fst o (get_obj g_result pt)) p
518 in if msg = "OK" then
519 case calculate_ (assoc_thy thy') isa_fn f of
520 SOME (f', (id, thm)) =>
521 Chead.Appl (Calculate' (thy',op_, f, (f', (id, string_of_thmI thm))))
522 | NONE => Chead.Notappl ("'calculate "^op_^"' not applicable")
523 else Chead.Notappl msg
526 (*Substitute combines two different kind of "substitution":
527 (1) subst_atomic: for ?a..?z
528 (2) Pattern.match: for solving equational systems
529 (which raises exn for ?a..?z)*)
530 | applicable_in (p,p_) pt (m as Substitute sube) =
531 if member op = [Pbl,Met] p_
532 then Chead.Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
535 val pp = par_pblobj pt p
536 val thy = assoc_thy (get_obj g_domID pt pp)
538 Frm => get_obj g_form pt p
539 | Res => (fst o (get_obj g_result pt)) p
540 val {rew_ord',erls,...} = Specify.get_met (get_obj g_metID pt pp)
541 val subte = sube2subte sube
542 val subst = sube2subst thy sube
543 val ro = assoc_rew_ord rew_ord'
545 if foldl and_ (true, map contains_Var subte)
548 let val f' = subst_atomic subst f
549 in if f = f' then Chead.Notappl (sube2str sube^" not applicable")
550 else Chead.Appl (Substitute' (ro, erls, subte, f, f'))
554 case rewrite_terms_ thy ro erls subte f of
555 SOME (f', _) => Chead.Appl (Substitute' (ro, erls, subte, f, f'))
556 | NONE => Chead.Notappl (sube2str sube^" not applicable")
559 | applicable_in p pt (Apply_Assumption cts') =
560 (error ("applicable_in: not impl. for " ^ (tac2str (Apply_Assumption cts'))))
562 (*'logical' applicability wrt. script in locate: Inconsistent?*)
563 | applicable_in (p,p_) pt (m as Take ct') =
564 if member op = [Pbl,Met] p_
565 then Chead.Notappl (tac2str m ^ " not for pos " ^ pos'2str (p,p_))
567 let val thy' = get_obj g_domID pt (par_pblobj pt p);
568 in (case parseNEW (assoc_thy thy' |> thy2ctxt) ct' of
569 SOME ct => Chead.Appl (Take' ct)
570 | NONE => Chead.Notappl ("syntax error in " ^ ct'))
573 | applicable_in p pt (Take_Inst ct') =
574 error ("applicable_in: not impl. for " ^ tac2str (Take_Inst ct'))
575 | applicable_in p pt (Group (con, ints)) =
576 error ("applicable_in: not impl. for " ^ tac2str (Group (con, ints)))
578 | applicable_in (p,p_) pt (m as Subproblem (domID, pblID)) =
579 if member op = [Pbl,Met] p_
580 then (*maybe Apply_Method has already been done FIXME.WN150511: declare_constraints*)
581 case get_obj g_env pt p of
583 Chead.Appl (Subproblem' ((domID, pblID, e_metID), [],
584 e_term, [], e_ctxt(*FIXME.WN150511*), subpbl domID pblID))
585 | NONE => Chead.Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
586 else (*somewhere later in the script*)
587 Chead.Appl (Subproblem' ((domID, pblID, e_metID), [],
588 e_term, [], e_ctxt, subpbl domID pblID))
590 | applicable_in p pt (End_Subproblem) =
591 error ("applicable_in: not impl. for " ^ tac2str End_Subproblem)
592 | applicable_in p pt (CAScmd ct') =
593 error ("applicable_in: not impl. for " ^ tac2str (CAScmd ct'))
594 | applicable_in p pt (Split_And) =
595 error ("applicable_in: not impl. for " ^ tac2str Split_And)
596 | applicable_in p pt (Conclude_And) =
597 error ("applicable_in: not impl. for " ^ tac2str Conclude_And)
598 | applicable_in p pt (Split_Or) =
599 error ("applicable_in: not impl. for " ^ tac2str Split_Or)
600 | applicable_in p pt (Conclude_Or) =
601 error ("applicable_in: not impl. for " ^ tac2str Conclude_Or)
603 | applicable_in (p,p_) pt (Begin_Trans) =
605 val (f,p) = case p_ of (*p 12.4.00 unnecessary*)
606 (*_____ implizit Take in gen*)
607 Frm => (get_obj g_form pt p, (lev_on o lev_dn) p)
608 | Res => ((fst o (get_obj g_result pt)) p, (lev_on o lev_dn o lev_on) p)
609 | _ => error ("applicable_in: call by "^
611 val thy' = get_obj g_domID pt (par_pblobj pt p);
612 in (Chead.Appl (Begin_Trans' f))
613 handle _ => error ("applicable_in: Begin_Trans finds \
614 \syntaxerror in '"^(term2str f)^"'") end
616 (*TODO: check parent branches*)
617 | applicable_in (p,p_) pt (End_Trans) =
618 let val thy' = get_obj g_domID pt (par_pblobj pt p);
620 then Chead.Appl (End_Trans' (get_obj g_result pt p))
621 else Chead.Notappl "'End_Trans' is not applicable at the beginning of a transitive sequence"
622 (*TODO: check parent branches*)
624 | applicable_in p pt (Begin_Sequ) =
625 error ("applicable_in: not impl. for " ^ tac2str (Begin_Sequ))
626 | applicable_in p pt (End_Sequ) =
627 error ("applicable_in: not impl. for " ^ tac2str (End_Sequ))
628 | applicable_in p pt (Split_Intersect) =
629 error ("applicable_in: not impl. for " ^ tac2str (Split_Intersect))
630 | applicable_in p pt (End_Intersect) =
631 error ("applicable_in: not impl. for " ^ tac2str (End_Intersect))
633 | applicable_in (p,p_) pt (m as Check_elementwise pred) =
634 if member op = [Pbl,Met] p_
635 then Chead.Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
638 val pp = par_pblobj pt p;
639 val thy' = (get_obj g_domID pt pp):theory';
640 val thy = assoc_thy thy'
641 val metID = (get_obj g_metID pt pp)
642 val {crls,...} = Specify.get_met metID
643 val (f,asm) = case p_ of Frm => (get_obj g_form pt p , [])
644 | Res => get_obj g_result pt p;
645 val vp = (thy2ctxt thy, pred) |-> parseNEW |> the |> mk_set thy pt p f;
647 Const ("List.list.Cons",_) $ _ $ _ =>
648 Chead.Appl (Check_elementwise' (f, pred, check_elementwise thy crls f vp))
649 | Const ("Tools.UniversalList",_) =>
650 Chead.Appl (Check_elementwise' (f, pred, (f,asm)))
651 | Const ("List.list.Nil",_) =>
652 Chead.Appl (Check_elementwise' (f, pred, (f, asm)))
653 | _ => Chead.Notappl ("Check_elementwise not applicable: "^(term2str f)^" should be constants")
656 | applicable_in (p,p_) pt Or_to_List =
657 if member op = [Pbl,Met] p_
658 then Chead.Notappl ((tac2str Or_to_List)^" not for pos "^(pos'2str (p,p_)))
661 val pp = par_pblobj pt p;
662 val thy' = (get_obj g_domID pt pp):theory';
663 val thy = assoc_thy thy';
665 Frm => get_obj g_form pt p
666 | Res => (fst o (get_obj g_result pt)) p;
667 in (let val ls = or2list f
668 in Chead.Appl (Or_to_List' (f, ls)) end)
669 handle _ => Chead.Notappl ("'Or_to_List' not applicable to "^(term2str f))
672 | applicable_in p pt (Collect_Trues) =
673 error ("applicable_in: not impl. for "^
674 (tac2str (Collect_Trues)))
676 | applicable_in p pt (Empty_Tac) =
677 Chead.Notappl "Empty_Tac is not applicable"
679 | applicable_in (p,p_) pt (Tac id) =
681 val pp = par_pblobj pt p;
682 val thy' = (get_obj g_domID pt pp):theory';
683 val thy = assoc_thy thy';
685 Frm => get_obj g_form pt p
686 | Pbl => error "applicable_in (p,Pbl) pt (Tac id): not at Pbl"
687 | Res => (fst o (get_obj g_result pt)) p;
689 "subproblem_equation_dummy" =>
691 then Chead.Appl (Tac_ (thy, term2str f, id,
692 "subproblem_equation_dummy ("^(term2str f)^")"))
693 else Chead.Notappl "applicable only to equations made explicit"
694 | "solve_equation_dummy" =>
695 let (*val _= tracing("### applicable_in: solve_equation_dummy: f= "
697 val (id',f') = split_dummy (term2str f);
698 (*val _= tracing("### applicable_in: f'= "^f');*)
699 (*val _= (Thm.term_of o the o (parse thy)) f';*)
700 (*val _= tracing"### applicable_in: solve_equation_dummy";*)
701 in if id' <> "subproblem_equation_dummy" then Chead.Notappl "no subproblem"
702 else if (thy2ctxt thy, f') |-> parseNEW |> the |> is_expliceq
703 then Chead.Appl (Tac_ (thy, term2str f, id, "[" ^ f' ^ "]"))
704 else error ("applicable_in: f= " ^ f') end
705 | _ => Chead.Appl (Tac_ (thy, term2str f, id, term2str f)) end
707 | applicable_in p pt End_Proof' = Chead.Appl End_Proof''
709 | applicable_in _ _ m =
710 error ("applicable_in called for "^(tac2str m));
713 fun tac2tac_ pt p m =
714 case applicable_in p pt m of
715 Chead.Appl (m') => m'
716 | Chead.Notappl _ => error ("tac2mstp': fails with"^