wneuper@59305
|
1 |
(* Title: Is a tacitc applicable ?
|
wneuper@59305
|
2 |
TODO: allocate these functions in appropriate structures
|
wneuper@59305
|
3 |
Author: Walther Neuper
|
wneuper@59305
|
4 |
(c) due to copyright terms
|
neuper@37936
|
5 |
*)
|
wneuper@59272
|
6 |
|
wneuper@59284
|
7 |
signature APPLICABLE =
|
wneuper@59284
|
8 |
sig
|
wneuper@59284
|
9 |
exception PTREE of string
|
walther@59735
|
10 |
datatype appl = Appl of Tactic.T | Notappl of string
|
walther@59735
|
11 |
val applicable_in : Ctree.pos' -> Ctree.ctree -> Tactic.input -> appl
|
wneuper@59310
|
12 |
(* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
|
wneuper@59571
|
13 |
val tac2tac_ : Ctree.ctree -> Ctree.pos' -> Tactic.input -> Tactic.T
|
walther@59702
|
14 |
(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
|
wneuper@59285
|
15 |
val mk_set : 'a -> ctree -> pos -> term -> term -> term * term list
|
walther@59702
|
16 |
( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
|
wneuper@59284
|
17 |
end
|
wneuper@59285
|
18 |
|
wneuper@59284
|
19 |
(**)
|
wneuper@59284
|
20 |
structure Applicable(**): APPLICABLE(**) =
|
wneuper@59272
|
21 |
struct
|
wneuper@59284
|
22 |
(**)
|
wneuper@59276
|
23 |
open Ctree
|
walther@59695
|
24 |
open Pos
|
wneuper@59272
|
25 |
|
wneuper@59416
|
26 |
fun rew_info (Rule.Rls {erls, rew_ord = (rew_ord', _), calc = ca, ...}) =
|
wneuper@59285
|
27 |
(rew_ord', erls, ca)
|
wneuper@59416
|
28 |
| rew_info (Rule.Seq {erls, rew_ord = (rew_ord', _), calc = ca, ...}) =
|
wneuper@59285
|
29 |
(rew_ord', erls, ca)
|
wneuper@59416
|
30 |
| rew_info (Rule.Rrls {erls, rew_ord = (rew_ord', _), calc = ca, ...}) =
|
wneuper@59285
|
31 |
(rew_ord', erls, ca)
|
wneuper@59416
|
32 |
| rew_info rls = error ("rew_info called with '" ^ Rule.rls2str rls ^ "'");
|
neuper@37906
|
33 |
|
neuper@37906
|
34 |
(*FIXME.3.4.03:re-organize from_pblobj_or_detail_thm after rls' --> rls*)
|
wneuper@59285
|
35 |
fun from_pblobj_or_detail_thm _ p pt =
|
neuper@52155
|
36 |
let
|
neuper@52155
|
37 |
val (pbl, p', rls') = par_pbl_det pt p
|
neuper@52155
|
38 |
in
|
neuper@52155
|
39 |
if pbl
|
neuper@52155
|
40 |
then
|
neuper@52155
|
41 |
let
|
neuper@52155
|
42 |
val thy' = get_obj g_domID pt p'
|
wneuper@59269
|
43 |
val {rew_ord', erls, ...} = Specify.get_met (get_obj g_metID pt p')
|
neuper@52155
|
44 |
in ("OK", thy', rew_ord', erls, false) end
|
neuper@52155
|
45 |
else
|
neuper@52155
|
46 |
let
|
neuper@52155
|
47 |
val thy' = get_obj g_domID pt (par_pblobj pt p)
|
neuper@52155
|
48 |
val (rew_ord', erls, _) = rew_info rls'
|
wneuper@59285
|
49 |
in ("OK", thy', rew_ord', erls, false) end
|
neuper@52155
|
50 |
end;
|
neuper@37906
|
51 |
(*FIXME.3.4.03:re-organize from_pblobj_or_detail_calc after rls' --> rls*)
|
neuper@37906
|
52 |
fun from_pblobj_or_detail_calc scrop p pt =
|
neuper@52155
|
53 |
let
|
wneuper@59285
|
54 |
val (pbl, p', rls') = par_pbl_det pt p
|
neuper@52155
|
55 |
in
|
neuper@52155
|
56 |
if pbl
|
neuper@52155
|
57 |
then
|
neuper@52155
|
58 |
let
|
neuper@52155
|
59 |
val thy' = get_obj g_domID pt p'
|
wneuper@59285
|
60 |
val {calc = scr_isa_fns, ...} = Specify.get_met (get_obj g_metID pt p')
|
neuper@52155
|
61 |
val opt = assoc (scr_isa_fns, scrop)
|
neuper@52155
|
62 |
in
|
neuper@52155
|
63 |
case opt of
|
wneuper@59285
|
64 |
SOME isa_fn => ("OK", thy', isa_fn)
|
wneuper@59416
|
65 |
| NONE => ("applicable_in Calculate: unknown '" ^ scrop ^ "'", "", ("", Rule.e_evalfn))
|
neuper@52155
|
66 |
end
|
neuper@52155
|
67 |
else
|
neuper@52155
|
68 |
let
|
neuper@52155
|
69 |
val thy' = get_obj g_domID pt (par_pblobj pt p);
|
wneuper@59285
|
70 |
val (_, _,(*_,*)scr_isa_fns) = rew_info rls'(*rls*)
|
neuper@52155
|
71 |
in
|
neuper@52155
|
72 |
case assoc (scr_isa_fns, scrop) of
|
neuper@52155
|
73 |
SOME isa_fn => ("OK",thy',isa_fn)
|
wneuper@59416
|
74 |
| NONE => ("applicable_in Calculate: unknown '" ^ scrop ^ "'", "", ("", Rule.e_evalfn))
|
neuper@52155
|
75 |
end
|
neuper@52155
|
76 |
end;
|
neuper@37906
|
77 |
|
wneuper@59285
|
78 |
(*for Check_elementwise in applicable_in: [x=1,..] Assumptions -> (x,0<=x&..)*)
|
wneuper@59416
|
79 |
fun mk_set _(*thy*) _ _ (Const ("List.list.Nil", _)) _ = (Rule.e_term, [])
|
walther@59620
|
80 |
| mk_set _ pt p (Const ("ListC.UniversalList", _)) pred =
|
wneuper@59601
|
81 |
(Rule.e_term, if pred <> Const ("Prog_Tac.Assumptions", HOLogic.boolT)
|
wneuper@59285
|
82 |
then [pred]
|
wneuper@59285
|
83 |
else get_assumptions_ pt (p, Res))
|
wneuper@59285
|
84 |
| mk_set _ pt p (Const ("List.list.Cons",_) $ eq $ _) pred =
|
wneuper@59285
|
85 |
let
|
wneuper@59285
|
86 |
val (bdv,_) = HOLogic.dest_eq eq;
|
wneuper@59601
|
87 |
val pred = if pred <> Const ("Prog_Tac.Assumptions", HOLogic.boolT)
|
wneuper@59285
|
88 |
then [pred]
|
wneuper@59285
|
89 |
else get_assumptions_ pt (p, Res)
|
wneuper@59285
|
90 |
in (bdv, pred) end
|
wneuper@59285
|
91 |
| mk_set _ _ _ l _ =
|
wneuper@59416
|
92 |
error ("check_elementwise: no set " ^ Rule.term2str l);
|
neuper@37906
|
93 |
|
wneuper@59285
|
94 |
(* check a list (/set) of constants [c_1,..,c_n] for c_i:set (: in)*)
|
neuper@37906
|
95 |
fun check_elementwise thy erls all_results (bdv, asm) =
|
wneuper@59285
|
96 |
let (*bdv extracted from ~~~~~~~~~~~ in mk_set already*)
|
wneuper@59285
|
97 |
fun check sub =
|
neuper@37906
|
98 |
let val inst_ = map (subst_atomic [sub]) asm
|
wneuper@59380
|
99 |
in case Rewrite.eval__true thy 1 inst_ [] erls of
|
wneuper@59285
|
100 |
(asm', true) => ([HOLogic.mk_eq sub], asm')
|
wneuper@59285
|
101 |
| (_, false) => ([],[])
|
neuper@37906
|
102 |
end;
|
wneuper@59389
|
103 |
val c' = TermC.isalist2list all_results
|
wneuper@59285
|
104 |
val c'' = map (snd o HOLogic.dest_eq) c' (*assumes [x=1,x=2,..]*)
|
wneuper@59285
|
105 |
val subs = map (pair bdv) c''
|
wneuper@59285
|
106 |
in
|
wneuper@59285
|
107 |
if asm = []
|
wneuper@59285
|
108 |
then (all_results, [])
|
wneuper@59390
|
109 |
else ((apfst ((TermC.list2isalist HOLogic.boolT) o flat)) o (apsnd flat) o split_list o (map check)) subs
|
wneuper@59285
|
110 |
end;
|
neuper@37906
|
111 |
|
wneuper@59285
|
112 |
(* for Tac-dummies in root-equ only: skip str until "("*)
|
wneuper@59285
|
113 |
fun split_dummy str =
|
wneuper@59285
|
114 |
let
|
wneuper@59285
|
115 |
fun scan s' [] = (implode s', "")
|
wneuper@59285
|
116 |
| scan s' (s :: ss) = if s = " " then (implode s', implode ss)
|
wneuper@59285
|
117 |
else scan (s' @ [s]) ss;
|
wneuper@59285
|
118 |
in ((scan []) o Symbol.explode) str end;
|
neuper@37906
|
119 |
|
walther@59735
|
120 |
datatype appl =
|
walther@59735
|
121 |
Appl of Tactic.T (* tactic is applicable at a certain position in the Ctree *)
|
walther@59735
|
122 |
| Notappl of string (* tactic is NOT applicable *)
|
walther@59735
|
123 |
|
wneuper@59578
|
124 |
(* applicability of a tacic wrt. a calc-state (ctree, pos').
|
wneuper@59559
|
125 |
additionally used by determine_next_tactic.
|
neuper@37906
|
126 |
tests for applicability are so expensive, that results (rewrites!)
|
wneuper@59285
|
127 |
are kept in the return-value of 'type tac_' *)
|
walther@59735
|
128 |
fun applicable_in _ _ (Tactic.Init_Proof (ct', spec)) = Appl (Tactic.Init_Proof' (ct', spec))
|
wneuper@59571
|
129 |
| applicable_in (p, p_) pt Tactic.Model_Problem =
|
neuper@41975
|
130 |
if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
|
walther@59735
|
131 |
then Notappl ((Tactic.tac2str Tactic.Model_Problem) ^ " not for pos " ^ (pos'2str (p, p_)))
|
neuper@41975
|
132 |
else
|
neuper@41975
|
133 |
let
|
wneuper@59285
|
134 |
val pI' = case get_obj I pt p of
|
wneuper@59285
|
135 |
PblObj {origin = (_, (_, pI', _),_), ...} => pI'
|
wneuper@59285
|
136 |
| _ => error "applicable_in Init_Proof: uncovered case get_obj"
|
wneuper@59285
|
137 |
val {ppc, ...} = Specify.get_pbt pI'
|
wneuper@59271
|
138 |
val pbl = Generate.init_pbl ppc
|
walther@59735
|
139 |
in Appl (Tactic.Model_Problem' (pI', pbl, [])) end
|
wneuper@59571
|
140 |
| applicable_in (p, p_) pt (Tactic.Refine_Tacitly pI) =
|
neuper@41975
|
141 |
if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
|
walther@59735
|
142 |
then Notappl ((Tactic.tac2str (Tactic.Refine_Tacitly pI)) ^ " not for pos " ^ (pos'2str (p, p_)))
|
neuper@41975
|
143 |
else
|
neuper@41975
|
144 |
let
|
wneuper@59285
|
145 |
val oris = case get_obj I pt p of
|
wneuper@59285
|
146 |
PblObj {origin = (oris, _, _), ...} => oris
|
wneuper@59285
|
147 |
| _ => error "applicable_in Refine_Tacitly: uncovered case get_obj"
|
wneuper@59285
|
148 |
in
|
wneuper@59285
|
149 |
case Specify.refine_ori oris pI of
|
wneuper@59285
|
150 |
SOME pblID =>
|
walther@59735
|
151 |
Appl (Tactic.Refine_Tacitly' (pI, pblID, Rule.e_domID, Celem.e_metID, [](*filled in specify*)))
|
walther@59735
|
152 |
| NONE => Notappl ((Tactic.tac2str (Tactic.Refine_Tacitly pI)) ^ " not applicable")
|
neuper@41975
|
153 |
end
|
wneuper@59571
|
154 |
| applicable_in (p, p_) pt (Tactic.Refine_Problem pI) =
|
wneuper@59285
|
155 |
if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
|
walther@59735
|
156 |
then Notappl ((Tactic.tac2str (Tactic.Refine_Problem pI)) ^ " not for pos "^(pos'2str (p, p_)))
|
wneuper@59285
|
157 |
else
|
wneuper@59285
|
158 |
let
|
wneuper@59285
|
159 |
val (dI, dI', itms) = case get_obj I pt p of
|
wneuper@59285
|
160 |
PblObj {origin= (_, (dI, _, _), _), spec= (dI', _, _), probl = itms, ...}
|
wneuper@59285
|
161 |
=> (dI, dI', itms)
|
wneuper@59285
|
162 |
| _ => error "applicable_in Refine_Problem: uncovered case get_obj"
|
wneuper@59416
|
163 |
val thy = if dI' = Rule.e_domID then dI else dI';
|
wneuper@59285
|
164 |
in
|
wneuper@59405
|
165 |
case Specify.refine_pbl (Celem.assoc_thy thy) pI itms of
|
walther@59735
|
166 |
NONE => Notappl ((Tactic.tac2str (Tactic.Refine_Problem pI)) ^ " not applicable")
|
wneuper@59285
|
167 |
| SOME (rf as (pI', _)) =>
|
wneuper@59285
|
168 |
if pI' = pI
|
walther@59735
|
169 |
then Notappl ((Tactic.tac2str (Tactic.Refine_Problem pI)) ^ " not applicable")
|
walther@59735
|
170 |
else Appl (Tactic.Refine_Problem' rf)
|
neuper@37906
|
171 |
end
|
wneuper@59285
|
172 |
(*the specify-tacs have cterm' instead term: parse+error here!!!: see appl_add*)
|
wneuper@59571
|
173 |
| applicable_in (p, p_) pt (Tactic.Add_Given ct') =
|
wneuper@59285
|
174 |
if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
|
walther@59735
|
175 |
then Notappl ((Tactic.tac2str (Tactic.Add_Given ct')) ^ " not for pos " ^ pos'2str (p, p_))
|
walther@59735
|
176 |
else Appl (Tactic.Add_Given' (ct', [(*filled in specify_additem*)]))
|
wneuper@59285
|
177 |
(*Add_.. should reject (dsc //) (see fmz=[] in sqrt*)
|
wneuper@59571
|
178 |
| applicable_in (p, p_) pt (Tactic.Del_Given ct') =
|
wneuper@59285
|
179 |
if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
|
walther@59735
|
180 |
then Notappl ((Tactic.tac2str (Tactic.Del_Given ct')) ^ " not for pos " ^ pos'2str (p, p_))
|
walther@59735
|
181 |
else Appl (Tactic.Del_Given' ct')
|
wneuper@59571
|
182 |
| applicable_in (p, p_) pt (Tactic.Add_Find ct') =
|
wneuper@59285
|
183 |
if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
|
walther@59735
|
184 |
then Notappl ((Tactic.tac2str (Tactic.Add_Find ct')) ^ " not for pos " ^ pos'2str (p, p_))
|
walther@59735
|
185 |
else Appl (Tactic.Add_Find' (ct', [(*filled in specify_additem*)]))
|
wneuper@59571
|
186 |
| applicable_in (p, p_) pt (Tactic.Del_Find ct') =
|
wneuper@59285
|
187 |
if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
|
walther@59735
|
188 |
then Notappl ((Tactic.tac2str (Tactic.Del_Find ct')) ^ " not for pos " ^ pos'2str (p, p_))
|
walther@59735
|
189 |
else Appl (Tactic.Del_Find' ct')
|
wneuper@59571
|
190 |
| applicable_in (p, p_) pt (Tactic.Add_Relation ct') =
|
wneuper@59285
|
191 |
if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
|
walther@59735
|
192 |
then Notappl ((Tactic.tac2str (Tactic.Add_Relation ct')) ^ " not for pos " ^ pos'2str (p, p_))
|
walther@59735
|
193 |
else Appl (Tactic.Add_Relation' (ct', [(*filled in specify_additem*)]))
|
wneuper@59571
|
194 |
| applicable_in (p, p_) pt (Tactic.Del_Relation ct') =
|
wneuper@59285
|
195 |
if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
|
walther@59735
|
196 |
then Notappl ((Tactic.tac2str (Tactic.Del_Relation ct')) ^ " not for pos " ^ pos'2str (p, p_))
|
walther@59735
|
197 |
else Appl (Tactic.Del_Relation' ct')
|
wneuper@59571
|
198 |
| applicable_in (p, p_) pt (Tactic.Specify_Theory dI) =
|
wneuper@59285
|
199 |
if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
|
walther@59735
|
200 |
then Notappl ((Tactic.tac2str (Tactic.Specify_Theory dI)) ^ " not for pos " ^ pos'2str (p, p_))
|
walther@59735
|
201 |
else Appl (Tactic.Specify_Theory' dI)
|
wneuper@59571
|
202 |
| applicable_in (p, p_) pt (Tactic.Specify_Problem pID) =
|
wneuper@59285
|
203 |
if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
|
walther@59735
|
204 |
then Notappl ((Tactic.tac2str (Tactic.Specify_Problem pID)) ^ " not for pos " ^ pos'2str (p, p_))
|
wneuper@59285
|
205 |
else
|
wneuper@59285
|
206 |
let
|
wneuper@59285
|
207 |
val (oris, dI, pI, dI', pI', itms) = case get_obj I pt p of
|
wneuper@59285
|
208 |
PblObj {origin = (oris, (dI, pI, _), _), spec = (dI', pI', _), probl = itms, ...}
|
wneuper@59285
|
209 |
=> (oris, dI, pI, dI', pI', itms)
|
wneuper@59285
|
210 |
| _ => error "applicable_in Specify_Problem: uncovered case get_obj"
|
wneuper@59416
|
211 |
val thy = Celem.assoc_thy (if dI' = Rule.e_domID then dI else dI');
|
wneuper@59285
|
212 |
val {ppc, where_, prls, ...} = Specify.get_pbt pID;
|
wneuper@59405
|
213 |
val pbl = if pI' = Celem.e_pblID andalso pI = Celem.e_pblID
|
wneuper@59285
|
214 |
then (false, (Generate.init_pbl ppc, []))
|
wneuper@59285
|
215 |
else Specify.match_itms_oris thy itms (ppc, where_, prls) oris;
|
wneuper@59285
|
216 |
in
|
walther@59735
|
217 |
Appl (Tactic.Specify_Problem' (pID, pbl))
|
wneuper@59285
|
218 |
end
|
wneuper@59571
|
219 |
| applicable_in (p, p_) pt (Tactic.Specify_Method mID) =
|
wneuper@59285
|
220 |
if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
|
walther@59735
|
221 |
then Notappl ((Tactic.tac2str (Tactic.Specify_Method mID)) ^ " not for pos " ^ pos'2str (p, p_))
|
walther@59735
|
222 |
else Appl (Tactic.Specify_Method' (mID, [(*filled in specify*)], [(*filled in specify*)]))
|
wneuper@59571
|
223 |
| applicable_in (p, p_) pt (Tactic.Apply_Method mI) =
|
wneuper@59285
|
224 |
if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
|
walther@59735
|
225 |
then Notappl ((Tactic.tac2str (Tactic.Apply_Method mI)) ^ " not for pos " ^ pos'2str (p, p_))
|
wneuper@59285
|
226 |
else
|
wneuper@59285
|
227 |
let
|
wneuper@59285
|
228 |
val (dI, pI, probl, ctxt) = case get_obj I pt p of
|
wneuper@59285
|
229 |
PblObj {origin = (_, (dI, pI, _), _), probl, ctxt, ...} => (dI, pI, probl, ctxt)
|
wneuper@59285
|
230 |
| _ => error "applicable_in Apply_Method: uncovered case get_obj"
|
wneuper@59285
|
231 |
val {where_, ...} = Specify.get_pbt pI
|
wneuper@59316
|
232 |
val pres = map (Model.mk_env probl |> subst_atomic) where_
|
walther@59719
|
233 |
val ctxt = if ContextC.is_e_ctxt ctxt
|
wneuper@59577
|
234 |
then Celem.assoc_thy dI |> Proof_Context.init_global |> ContextC.insert_assumptions pres
|
wneuper@59285
|
235 |
else ctxt
|
wneuper@59285
|
236 |
(*TODO.WN110416 here do evalprecond according to fun check_preconds'
|
walther@59735
|
237 |
and then decide on Notappl/Appl accordingly once more.
|
wneuper@59285
|
238 |
Implement after all tests are running, since this changes
|
wneuper@59285
|
239 |
overall system behavior*)
|
wneuper@59285
|
240 |
in
|
walther@59737
|
241 |
Appl (Tactic.Apply_Method' (mI, NONE, Istate_Def.e_istate (*filled in solve*), ctxt))
|
wneuper@59285
|
242 |
end
|
wneuper@59571
|
243 |
| applicable_in (p, p_) _ (Tactic.Check_Postcond pI) =
|
wneuper@59285
|
244 |
if member op = [Pbl, Met] p_
|
walther@59735
|
245 |
then Notappl ((Tactic.tac2str (Tactic.Check_Postcond pI)) ^ " not for pos " ^ pos'2str (p, p_))
|
walther@59735
|
246 |
else Appl (Tactic.Check_Postcond' (pI, (Rule.e_term, [(*fun solve assigns returnvalue of scr*)])))
|
walther@59735
|
247 |
| applicable_in _ _ (Tactic.Take str) = Appl (Tactic.Take' (TermC.str2term str)) (* always applicable ?*)
|
walther@59735
|
248 |
| applicable_in _ _ (Tactic.Free_Solve) = Appl (Tactic.Free_Solve') (* always applicable *)
|
wneuper@59571
|
249 |
| applicable_in (p, p_) pt (m as Tactic.Rewrite_Inst (subs, thm'')) =
|
neuper@42394
|
250 |
if member op = [Pbl, Met] p_
|
walther@59735
|
251 |
then Notappl ((Tactic.tac2str m)^" not for pos " ^ pos'2str (p, p_))
|
neuper@42394
|
252 |
else
|
neuper@42394
|
253 |
let
|
neuper@42394
|
254 |
val pp = par_pblobj pt p;
|
wneuper@59405
|
255 |
val thy' = get_obj g_domID pt pp;
|
wneuper@59405
|
256 |
val thy = Celem.assoc_thy thy';
|
wneuper@59269
|
257 |
val {rew_ord' = ro', erls = erls, ...} = Specify.get_met (get_obj g_metID pt pp);
|
wneuper@59285
|
258 |
val (f, _) = case p_ of (*p 12.4.00 unnecessary*)
|
neuper@42394
|
259 |
Frm => (get_obj g_form pt p, p)
|
neuper@42394
|
260 |
| Res => ((fst o (get_obj g_result pt)) p, lev_on p)
|
wneuper@59285
|
261 |
| _ => error ("applicable_in: call by " ^ pos'2str (p, p_));
|
neuper@42394
|
262 |
in
|
neuper@42394
|
263 |
let
|
wneuper@59301
|
264 |
val subst = Selem.subs2subst thy subs;
|
wneuper@59285
|
265 |
in
|
wneuper@59416
|
266 |
case Rewrite.rewrite_inst_ thy (Rule.assoc_rew_ord ro') erls false subst (snd thm'') f of
|
wneuper@59285
|
267 |
SOME (f',asm) =>
|
walther@59735
|
268 |
Appl (Tactic.Rewrite_Inst' (thy', ro', erls, false, subst, thm'', f, (f', asm)))
|
walther@59735
|
269 |
| NONE => Notappl ((fst thm'')^" not applicable")
|
neuper@42394
|
270 |
end
|
walther@59735
|
271 |
handle _ => Notappl ("syntax error in "^(subs2str subs))
|
neuper@42394
|
272 |
end
|
wneuper@59571
|
273 |
| applicable_in (p, p_) pt (m as Tactic.Rewrite thm'') =
|
wneuper@59285
|
274 |
if member op = [Pbl, Met] p_
|
walther@59735
|
275 |
then Notappl ((Tactic.tac2str m)^" not for pos "^(pos'2str (p, p_)))
|
neuper@37906
|
276 |
else
|
wneuper@59285
|
277 |
let
|
wneuper@59285
|
278 |
val (msg, thy', ro, rls', _)= from_pblobj_or_detail_thm thm'' p pt;
|
wneuper@59405
|
279 |
val thy = Celem.assoc_thy thy';
|
wneuper@59285
|
280 |
val f = case p_ of
|
wneuper@59285
|
281 |
Frm => get_obj g_form pt p
|
wneuper@59285
|
282 |
| Res => (fst o (get_obj g_result pt)) p
|
wneuper@59285
|
283 |
| _ => error ("applicable_in Rewrite: call by " ^ pos'2str (p, p_));
|
wneuper@59285
|
284 |
in
|
wneuper@59285
|
285 |
if msg = "OK"
|
wneuper@59285
|
286 |
then
|
wneuper@59416
|
287 |
case Rewrite.rewrite_ thy (Rule.assoc_rew_ord ro) rls' false (snd thm'') f of
|
walther@59735
|
288 |
SOME (f',asm) => Appl (Tactic.Rewrite' (thy', ro, rls', false, thm'', f, (f', asm)))
|
walther@59735
|
289 |
| NONE => Notappl ("'" ^ fst thm'' ^"' not applicable")
|
walther@59735
|
290 |
else Notappl msg
|
wneuper@59285
|
291 |
end
|
wneuper@59571
|
292 |
| applicable_in (p, p_) pt (m as Tactic.Rewrite_Asm thm'') =
|
wneuper@59285
|
293 |
if member op = [Pbl, Met] p_
|
walther@59735
|
294 |
then Notappl ((Tactic.tac2str m)^" not for pos "^(pos'2str (p,p_)))
|
wneuper@59285
|
295 |
else
|
wneuper@59285
|
296 |
let
|
wneuper@59285
|
297 |
val pp = par_pblobj pt p;
|
wneuper@59405
|
298 |
val thy' = get_obj g_domID pt pp;
|
wneuper@59405
|
299 |
val thy = Celem.assoc_thy thy';
|
wneuper@59285
|
300 |
val {rew_ord'=ro',erls=erls,...} = Specify.get_met (get_obj g_metID pt pp);
|
wneuper@59285
|
301 |
val (f, _) = case p_ of
|
wneuper@59285
|
302 |
Frm => (get_obj g_form pt p, p)
|
wneuper@59285
|
303 |
| Res => ((fst o (get_obj g_result pt)) p, lev_on p)
|
wneuper@59285
|
304 |
| _ => error ("applicable_in: call by " ^ pos'2str (p, p_));
|
wneuper@59285
|
305 |
in
|
wneuper@59416
|
306 |
case Rewrite.rewrite_ thy (Rule.assoc_rew_ord ro') erls false (snd thm'') f of
|
walther@59735
|
307 |
SOME (f',asm) => Appl (Tactic.Rewrite' (thy', ro', erls, false, thm'', f, (f', asm)))
|
walther@59735
|
308 |
| NONE => Notappl ("'" ^ fst thm'' ^ "' not applicable") end
|
wneuper@59571
|
309 |
| applicable_in (p, p_) pt (m as Tactic.Detail_Set_Inst (subs, rls)) =
|
wneuper@59285
|
310 |
if member op = [Pbl, Met] p_
|
walther@59735
|
311 |
then Notappl ((Tactic.tac2str m)^" not for pos "^(pos'2str (p, p_)))
|
wneuper@59285
|
312 |
else
|
wneuper@59285
|
313 |
let
|
wneuper@59285
|
314 |
val pp = par_pblobj pt p;
|
wneuper@59285
|
315 |
val thy' = get_obj g_domID pt pp;
|
wneuper@59405
|
316 |
val thy = Celem.assoc_thy thy';
|
wneuper@59285
|
317 |
val f = case p_ of Frm => get_obj g_form pt p
|
wneuper@59285
|
318 |
| Res => (fst o (get_obj g_result pt)) p
|
wneuper@59285
|
319 |
| _ => error ("applicable_in: call by " ^ pos'2str (p, p_));
|
wneuper@59301
|
320 |
val subst = Selem.subs2subst thy subs
|
wneuper@59285
|
321 |
in
|
wneuper@59380
|
322 |
case Rewrite.rewrite_set_inst_ thy false subst (assoc_rls rls) f of
|
wneuper@59285
|
323 |
SOME (f', asm)
|
walther@59735
|
324 |
=> Appl (Tactic.Detail_Set_Inst' (thy', false, subst, assoc_rls rls, f, (f', asm)))
|
walther@59735
|
325 |
| NONE => Notappl (rls ^ " not applicable")
|
walther@59735
|
326 |
handle _ => Notappl ("syntax error in " ^ subs2str subs)
|
wneuper@59285
|
327 |
end
|
wneuper@59571
|
328 |
| applicable_in (p, p_) pt (m as Tactic.Rewrite_Set_Inst (subs, rls)) =
|
wneuper@59285
|
329 |
if member op = [Pbl, Met] p_
|
walther@59735
|
330 |
then Notappl ((Tactic.tac2str m)^" not for pos "^(pos'2str (p,p_)))
|
wneuper@59285
|
331 |
else
|
wneuper@59285
|
332 |
let
|
wneuper@59285
|
333 |
val pp = par_pblobj pt p;
|
wneuper@59285
|
334 |
val thy' = get_obj g_domID pt pp;
|
wneuper@59405
|
335 |
val thy = Celem.assoc_thy thy';
|
wneuper@59285
|
336 |
val (f, _) = case p_ of
|
wneuper@59285
|
337 |
Frm => (get_obj g_form pt p, p)
|
wneuper@59285
|
338 |
| Res => ((fst o (get_obj g_result pt)) p, lev_on p)
|
wneuper@59285
|
339 |
| _ => error ("applicable_in: call by " ^ pos'2str (p, p_));
|
wneuper@59301
|
340 |
val subst = Selem.subs2subst thy subs;
|
wneuper@59285
|
341 |
in
|
wneuper@59380
|
342 |
case Rewrite.rewrite_set_inst_ thy (*put_asm*)false subst (assoc_rls rls) f of
|
wneuper@59285
|
343 |
SOME (f',asm)
|
walther@59735
|
344 |
=> Appl (Tactic.Rewrite_Set_Inst' (thy', false, subst, assoc_rls rls, f, (f', asm)))
|
walther@59735
|
345 |
| NONE => Notappl (rls ^ " not applicable")
|
walther@59735
|
346 |
handle _ => Notappl ("syntax error in " ^(subs2str subs))
|
wneuper@59285
|
347 |
end
|
wneuper@59571
|
348 |
| applicable_in (p, p_) pt (m as Tactic.Rewrite_Set rls) =
|
wneuper@59285
|
349 |
if member op = [Pbl, Met] p_
|
walther@59735
|
350 |
then Notappl (Tactic.tac2str m ^ " not for pos " ^ pos'2str (p, p_))
|
wneuper@59285
|
351 |
else
|
wneuper@59285
|
352 |
let
|
wneuper@59285
|
353 |
val pp = par_pblobj pt p;
|
wneuper@59285
|
354 |
val thy' = get_obj g_domID pt pp;
|
wneuper@59285
|
355 |
val (f, _) = case p_ of
|
wneuper@59285
|
356 |
Frm => (get_obj g_form pt p, p)
|
wneuper@59285
|
357 |
| Res => ((fst o (get_obj g_result pt)) p, lev_on p)
|
wneuper@59285
|
358 |
| _ => error ("applicable_in: call by " ^ pos'2str (p, p_));
|
wneuper@59285
|
359 |
in
|
wneuper@59405
|
360 |
case Rewrite.rewrite_set_ (Celem.assoc_thy thy') false (assoc_rls rls) f of
|
wneuper@59285
|
361 |
SOME (f', asm)
|
walther@59735
|
362 |
=> Appl (Tactic.Rewrite_Set' (thy', false, assoc_rls rls, f, (f', asm)))
|
walther@59735
|
363 |
| NONE => Notappl (rls ^ " not applicable")
|
wneuper@59285
|
364 |
end
|
wneuper@59571
|
365 |
| applicable_in (p, p_) pt (m as Tactic.Detail_Set rls) =
|
wneuper@59285
|
366 |
if member op = [Pbl, Met] p_
|
walther@59735
|
367 |
then Notappl (Tactic.tac2str m ^ " not for pos " ^ pos'2str (p, p_))
|
wneuper@59285
|
368 |
else
|
wneuper@59285
|
369 |
let
|
wneuper@59285
|
370 |
val pp = par_pblobj pt p
|
wneuper@59285
|
371 |
val thy' = get_obj g_domID pt pp
|
wneuper@59285
|
372 |
val f = case p_ of
|
wneuper@59285
|
373 |
Frm => get_obj g_form pt p
|
wneuper@59285
|
374 |
| Res => (fst o (get_obj g_result pt)) p
|
wneuper@59285
|
375 |
| _ => error ("applicable_in: call by " ^ pos'2str (p, p_));
|
wneuper@59285
|
376 |
in
|
wneuper@59405
|
377 |
case Rewrite.rewrite_set_ (Celem.assoc_thy thy') false (assoc_rls rls) f of
|
walther@59735
|
378 |
SOME (f',asm) => Appl (Tactic.Detail_Set' (thy', false, assoc_rls rls, f, (f', asm)))
|
walther@59735
|
379 |
| NONE => Notappl (rls^" not applicable")
|
wneuper@59285
|
380 |
end
|
wneuper@59571
|
381 |
| applicable_in _ _ Tactic.End_Ruleset = error ("applicable_in: not impl. for " ^ Tactic.tac2str Tactic.End_Ruleset)
|
wneuper@59571
|
382 |
| applicable_in (p, p_) pt (m as Tactic.Calculate op_) =
|
wneuper@59285
|
383 |
if member op = [Pbl, Met] p_
|
walther@59735
|
384 |
then Notappl ((Tactic.tac2str m)^" not for pos "^(pos'2str (p,p_)))
|
wneuper@59285
|
385 |
else
|
wneuper@59285
|
386 |
let
|
wneuper@59285
|
387 |
val (msg,thy',isa_fn) = from_pblobj_or_detail_calc op_ p pt;
|
wneuper@59285
|
388 |
val f = case p_ of
|
wneuper@59285
|
389 |
Frm => get_obj g_form pt p
|
wneuper@59285
|
390 |
| Res => (fst o (get_obj g_result pt)) p
|
wneuper@59285
|
391 |
| _ => error ("applicable_in: call by " ^ pos'2str (p, p_));
|
wneuper@59285
|
392 |
in
|
wneuper@59285
|
393 |
if msg = "OK"
|
wneuper@59285
|
394 |
then
|
wneuper@59405
|
395 |
case Rewrite.calculate_ (Celem.assoc_thy thy') isa_fn f of
|
wneuper@59285
|
396 |
SOME (f', (id, thm))
|
walther@59735
|
397 |
=> Appl (Tactic.Calculate' (thy', op_, f, (f', (id, Rule.string_of_thmI thm))))
|
walther@59735
|
398 |
| NONE => Notappl ("'calculate "^op_^"' not applicable")
|
walther@59735
|
399 |
else Notappl msg
|
wneuper@59285
|
400 |
end
|
wneuper@59285
|
401 |
(*Substitute combines two different kind of "substitution":
|
wneuper@59285
|
402 |
(1) subst_atomic: for ?a..?z
|
wneuper@59285
|
403 |
(2) Pattern.match: for solving equational systems (which raises exn for ?a..?z)*)
|
wneuper@59571
|
404 |
| applicable_in (p, p_) pt (m as Tactic.Substitute sube) =
|
wneuper@59285
|
405 |
if member op = [Pbl, Met] p_
|
walther@59735
|
406 |
then Notappl (Tactic.tac2str m ^ " not for pos " ^ pos'2str (p, p_))
|
neuper@42360
|
407 |
else
|
neuper@42360
|
408 |
let
|
neuper@42360
|
409 |
val pp = par_pblobj pt p
|
wneuper@59405
|
410 |
val thy = Celem.assoc_thy (get_obj g_domID pt pp)
|
neuper@42360
|
411 |
val f = case p_ of
|
neuper@42360
|
412 |
Frm => get_obj g_form pt p
|
neuper@42360
|
413 |
| Res => (fst o (get_obj g_result pt)) p
|
wneuper@59285
|
414 |
| _ => error ("applicable_in: call by " ^ pos'2str (p, p_));
|
wneuper@59269
|
415 |
val {rew_ord',erls,...} = Specify.get_met (get_obj g_metID pt pp)
|
wneuper@59301
|
416 |
val subte = Selem.sube2subte sube
|
wneuper@59301
|
417 |
val subst = Selem.sube2subst thy sube
|
wneuper@59416
|
418 |
val ro = Rule.assoc_rew_ord rew_ord'
|
neuper@42360
|
419 |
in
|
wneuper@59389
|
420 |
if foldl and_ (true, map TermC.contains_Var subte)
|
wneuper@59285
|
421 |
then (*1*)
|
neuper@42360
|
422 |
let val f' = subst_atomic subst f
|
wneuper@59285
|
423 |
in if f = f'
|
walther@59735
|
424 |
then Notappl (Selem.sube2str sube^" not applicable")
|
walther@59735
|
425 |
else Appl (Tactic.Substitute' (ro, erls, subte, f, f'))
|
neuper@42360
|
426 |
end
|
wneuper@59285
|
427 |
else (*2*)
|
wneuper@59380
|
428 |
case Rewrite.rewrite_terms_ thy ro erls subte f of
|
walther@59735
|
429 |
SOME (f', _) => Appl (Tactic.Substitute' (ro, erls, subte, f, f'))
|
walther@59735
|
430 |
| NONE => Notappl (Selem.sube2str sube ^ " not applicable")
|
neuper@42360
|
431 |
end
|
wneuper@59571
|
432 |
| applicable_in _ _ (Tactic.Apply_Assumption cts') =
|
wneuper@59571
|
433 |
error ("applicable_in: not impl. for " ^ Tactic.tac2str (Tactic.Apply_Assumption cts'))
|
wneuper@59559
|
434 |
(* 'logical' applicability wrt. script in locate_input_tactic: Inconsistent? *)
|
wneuper@59571
|
435 |
| applicable_in _ _ (Tactic.Take_Inst ct') =
|
wneuper@59571
|
436 |
error ("applicable_in: not impl. for " ^ Tactic.tac2str (Tactic.Take_Inst ct'))
|
wneuper@59571
|
437 |
| applicable_in (p, p_) pt (m as Tactic.Subproblem (domID, pblID)) =
|
neuper@37935
|
438 |
if member op = [Pbl,Met] p_
|
neuper@41993
|
439 |
then (*maybe Apply_Method has already been done FIXME.WN150511: declare_constraints*)
|
neuper@41993
|
440 |
case get_obj g_env pt p of
|
wneuper@59285
|
441 |
SOME _ =>
|
walther@59735
|
442 |
Appl (Tactic.Subproblem' ((domID, pblID, Celem.e_metID), [],
|
walther@59618
|
443 |
Rule.e_term, [], ContextC.e_ctxt(*init. in Subproblem'*), Auto_Prog.subpbl domID pblID))
|
walther@59735
|
444 |
| NONE => Notappl (Tactic.tac2str m ^ " not for pos " ^ pos'2str (p,p_))
|
neuper@37906
|
445 |
else (*somewhere later in the script*)
|
walther@59735
|
446 |
Appl (Tactic.Subproblem' ((domID, pblID, Celem.e_metID), [],
|
walther@59618
|
447 |
Rule.e_term, [], ContextC.e_ctxt, Auto_Prog.subpbl domID pblID))
|
wneuper@59571
|
448 |
| applicable_in _ _ (Tactic.End_Subproblem) =
|
wneuper@59571
|
449 |
error ("applicable_in: not impl. for " ^ Tactic.tac2str Tactic.End_Subproblem)
|
wneuper@59571
|
450 |
| applicable_in _ _ (Tactic.CAScmd ct') =
|
wneuper@59571
|
451 |
error ("applicable_in: not impl. for " ^ Tactic.tac2str (Tactic.CAScmd ct'))
|
wneuper@59571
|
452 |
| applicable_in _ _ (Tactic.Split_And) =
|
wneuper@59571
|
453 |
error ("applicable_in: not impl. for " ^ Tactic.tac2str Tactic.Split_And)
|
wneuper@59571
|
454 |
| applicable_in _ _ (Tactic.Conclude_And) =
|
wneuper@59571
|
455 |
error ("applicable_in: not impl. for " ^ Tactic.tac2str Tactic.Conclude_And)
|
wneuper@59571
|
456 |
| applicable_in _ _ (Tactic.Split_Or) =
|
wneuper@59571
|
457 |
error ("applicable_in: not impl. for " ^ Tactic.tac2str Tactic.Split_Or)
|
wneuper@59571
|
458 |
| applicable_in _ _ (Tactic.Conclude_Or) =
|
wneuper@59571
|
459 |
error ("applicable_in: not impl. for " ^ Tactic.tac2str Tactic.Conclude_Or)
|
wneuper@59571
|
460 |
| applicable_in (p, p_) pt (Tactic.Begin_Trans) =
|
neuper@37906
|
461 |
let
|
wneuper@59285
|
462 |
val (f, _) = case p_ of (*p 12.4.00 unnecessary, implizit Take in gen*)
|
wneuper@59285
|
463 |
Frm => (get_obj g_form pt p, (lev_on o lev_dn) p)
|
neuper@37906
|
464 |
| Res => ((fst o (get_obj g_result pt)) p, (lev_on o lev_dn o lev_on) p)
|
wneuper@59285
|
465 |
| _ => error ("applicable_in: call by " ^ pos'2str (p, p_));
|
walther@59735
|
466 |
in (Appl (Tactic.Begin_Trans' f))
|
wneuper@59416
|
467 |
handle _ => error ("applicable_in: Begin_Trans finds syntaxerror in '" ^ Rule.term2str f ^ "'")
|
neuper@37906
|
468 |
end
|
wneuper@59571
|
469 |
| applicable_in (p, p_) pt (Tactic.End_Trans) = (*TODO: check parent branches*)
|
wneuper@59285
|
470 |
if p_ = Res
|
walther@59735
|
471 |
then Appl (Tactic.End_Trans' (get_obj g_result pt p))
|
walther@59735
|
472 |
else Notappl "'End_Trans' is not applicable at the beginning of a transitive sequence"
|
wneuper@59571
|
473 |
| applicable_in _ _ (Tactic.Begin_Sequ) =
|
wneuper@59571
|
474 |
error ("applicable_in: not impl. for " ^ Tactic.tac2str (Tactic.Begin_Sequ))
|
wneuper@59571
|
475 |
| applicable_in _ _ (Tactic.End_Sequ) =
|
wneuper@59571
|
476 |
error ("applicable_in: not impl. for " ^ Tactic.tac2str (Tactic.End_Sequ))
|
wneuper@59571
|
477 |
| applicable_in _ _ (Tactic.Split_Intersect) =
|
wneuper@59571
|
478 |
error ("applicable_in: not impl. for " ^ Tactic.tac2str (Tactic.Split_Intersect))
|
wneuper@59571
|
479 |
| applicable_in _ _ (Tactic.End_Intersect) =
|
wneuper@59571
|
480 |
error ("applicable_in: not impl. for " ^ Tactic.tac2str (Tactic.End_Intersect))
|
wneuper@59571
|
481 |
| applicable_in (p, p_) pt (m as Tactic.Check_elementwise pred) =
|
walther@59722
|
482 |
if member op = [Pbl, Met] p_
|
walther@59735
|
483 |
then Notappl ((Tactic.tac2str m) ^ " not for pos " ^ pos'2str (p, p_))
|
neuper@42394
|
484 |
else
|
neuper@42394
|
485 |
let
|
neuper@42394
|
486 |
val pp = par_pblobj pt p;
|
wneuper@59405
|
487 |
val thy' = get_obj g_domID pt pp;
|
wneuper@59405
|
488 |
val thy = Celem.assoc_thy thy'
|
neuper@42394
|
489 |
val metID = (get_obj g_metID pt pp)
|
walther@59722
|
490 |
val {crls, ...} = Specify.get_met metID
|
wneuper@59285
|
491 |
val (f, asm) = case p_ of
|
wneuper@59285
|
492 |
Frm => (get_obj g_form pt p , [])
|
wneuper@59285
|
493 |
| Res => get_obj g_result pt p
|
wneuper@59285
|
494 |
| _ => error ("applicable_in: call by " ^ pos'2str (p, p_));
|
wneuper@59416
|
495 |
val vp = (Rule.thy2ctxt thy, pred) |-> TermC.parseNEW |> the |> mk_set thy pt p f;
|
neuper@42394
|
496 |
in case f of
|
walther@59722
|
497 |
Const ("List.list.Cons", _) $ _ $ _ =>
|
walther@59735
|
498 |
Appl (Tactic.Check_elementwise' (f, pred, check_elementwise thy crls f vp))
|
walther@59722
|
499 |
| Const ("ListC.UniversalList", _) =>
|
walther@59735
|
500 |
Appl (Tactic.Check_elementwise' (f, pred, (f,asm)))
|
walther@59722
|
501 |
| Const ("List.list.Nil", _) =>
|
walther@59735
|
502 |
Appl (Tactic.Check_elementwise' (f, pred, (f, asm)))
|
walther@59735
|
503 |
| _ => Notappl ("Check_elementwise not appl.: " ^ Rule.term2str f ^ " should be constants")
|
neuper@42394
|
504 |
end
|
wneuper@59571
|
505 |
| applicable_in (p, p_) pt Tactic.Or_to_List =
|
wneuper@59285
|
506 |
if member op = [Pbl, Met] p_
|
walther@59735
|
507 |
then Notappl ((Tactic.tac2str Tactic.Or_to_List)^" not for pos "^(pos'2str (p,p_)))
|
wneuper@59285
|
508 |
else
|
wneuper@59285
|
509 |
let
|
wneuper@59285
|
510 |
val f = case p_ of
|
wneuper@59285
|
511 |
Frm => get_obj g_form pt p
|
wneuper@59285
|
512 |
| Res => (fst o (get_obj g_result pt)) p
|
wneuper@59285
|
513 |
| _ => error ("applicable_in: call by " ^ pos'2str (p, p_));
|
walther@59603
|
514 |
in (let val ls = Prog_Expr.or2list f
|
walther@59735
|
515 |
in Appl (Tactic.Or_to_List' (f, ls)) end)
|
walther@59735
|
516 |
handle _ => Notappl ("'Or_to_List' not applicable to " ^ Rule.term2str f)
|
wneuper@59285
|
517 |
end
|
wneuper@59571
|
518 |
| applicable_in _ _ Tactic.Collect_Trues =
|
wneuper@59571
|
519 |
error ("applicable_in: not impl. for " ^ Tactic.tac2str Tactic.Collect_Trues)
|
walther@59735
|
520 |
| applicable_in _ _ Tactic.Empty_Tac = Notappl "Empty_Tac is not applicable"
|
wneuper@59571
|
521 |
| applicable_in (p, p_) pt (Tactic.Tac id) =
|
wneuper@59285
|
522 |
let
|
wneuper@59285
|
523 |
val pp = par_pblobj pt p;
|
wneuper@59405
|
524 |
val thy' = get_obj g_domID pt pp;
|
wneuper@59405
|
525 |
val thy = Celem.assoc_thy thy';
|
wneuper@59285
|
526 |
val f = case p_ of
|
wneuper@59285
|
527 |
Frm => get_obj g_form pt p
|
wneuper@59285
|
528 |
| Pbl => error "applicable_in (p,Pbl) pt (Tac id): not at Pbl"
|
wneuper@59285
|
529 |
| Res => (fst o (get_obj g_result pt)) p
|
wneuper@59285
|
530 |
| _ => error ("applicable_in: call by " ^ pos'2str (p, p_));
|
wneuper@59285
|
531 |
in case id of
|
wneuper@59285
|
532 |
"subproblem_equation_dummy" =>
|
wneuper@59389
|
533 |
if TermC.is_expliceq f
|
walther@59735
|
534 |
then Appl (Tactic.Tac_ (thy, Rule.term2str f, id, "subproblem_equation_dummy (" ^ Rule.term2str f ^ ")"))
|
walther@59735
|
535 |
else Notappl "applicable only to equations made explicit"
|
wneuper@59285
|
536 |
| "solve_equation_dummy" =>
|
wneuper@59416
|
537 |
let val (id', f') = split_dummy (Rule.term2str f);
|
wneuper@59285
|
538 |
in
|
wneuper@59285
|
539 |
if id' <> "subproblem_equation_dummy"
|
walther@59735
|
540 |
then Notappl "no subproblem"
|
wneuper@59416
|
541 |
else if (Rule.thy2ctxt thy, f') |-> TermC.parseNEW |> the |> TermC.is_expliceq
|
walther@59735
|
542 |
then Appl (Tactic.Tac_ (thy, Rule.term2str f, id, "[" ^ f' ^ "]"))
|
wneuper@59285
|
543 |
else error ("applicable_in: f= " ^ f')
|
wneuper@59285
|
544 |
end
|
walther@59735
|
545 |
| _ => Appl (Tactic.Tac_ (thy, Rule.term2str f, id, Rule.term2str f))
|
wneuper@59285
|
546 |
end
|
walther@59735
|
547 |
| applicable_in _ _ Tactic.End_Proof' = Appl Tactic.End_Proof''
|
wneuper@59571
|
548 |
| applicable_in _ _ m = error ("applicable_in called for " ^ Tactic.tac2str m);
|
neuper@37906
|
549 |
|
wneuper@59285
|
550 |
fun tac2tac_ pt p m =
|
wneuper@59285
|
551 |
case applicable_in p pt m of
|
walther@59735
|
552 |
Appl m' => m'
|
walther@59735
|
553 |
| Notappl _ => error ("tac2mstp': fails with" ^ Tactic.tac2str m);
|
neuper@37906
|
554 |
|
wneuper@59285
|
555 |
end;
|