140 |
140 |
141 (*FIXME.WN050821 compare solve ... nxt_solv*) |
141 (*FIXME.WN050821 compare solve ... nxt_solv*) |
142 (* val ("Apply_Method",Apply_Method' (mI,_))=(mI,m); |
142 (* val ("Apply_Method",Apply_Method' (mI,_))=(mI,m); |
143 val (("Apply_Method",Apply_Method' (mI,_,_)),pt, pos as (p,_))=(m,pt, pos); |
143 val (("Apply_Method",Apply_Method' (mI,_,_)),pt, pos as (p,_))=(m,pt, pos); |
144 *) |
144 *) |
145 fun solve ("Apply_Method", m as Apply_Method' (mI, _, _)) |
145 fun solve ("Apply_Method", m as Apply_Method' (mI, _, _, _)) |
146 (pt:ptree, (pos as (p,_))) = |
146 (pt:ptree, (pos as (p,_))) = |
147 let val {srls,...} = get_met mI; |
147 let val {srls,...} = get_met mI; |
148 val PblObj{meth=itms,...} = get_obj I pt p; |
148 val PblObj{meth=itms,...} = get_obj I pt p; |
149 val thy' = get_obj g_domID pt p; |
149 val thy' = get_obj g_domID pt p; |
150 val thy = assoc_thy thy'; |
150 val thy = assoc_thy thy'; |
151 val (is as ScrState (env,_,_,_,_,_), sc) = init_scrstate thy itms mI; |
151 val (is as ScrState (env,_,_,_,_,_), ctxt, sc) = init_scrstate thy itms mI; |
152 val ini = init_form thy sc env; |
152 val ini = init_form thy sc env; |
153 val p = lev_dn p; |
153 val p = lev_dn p; |
154 in |
154 in |
155 case ini of |
155 case ini of |
156 SOME t => (* val SOME t = ini; |
156 SOME t => (* val SOME t = ini; |
157 *) |
157 *) |
158 let val (pos,c,_,pt) = |
158 let val (pos,c,_,pt) = |
159 generate1 thy (Apply_Method' (mI, SOME t, is)) |
159 generate1 thy (Apply_Method' (mI, SOME t, is, ctxt)) |
160 is (lev_on p, Frm)(*implicit Take*) pt; |
160 (is, ctxt) (lev_on p, Frm)(*implicit Take*) pt; |
161 in ("ok",([(Apply_Method mI, Apply_Method' (mI, SOME t, is), |
161 in ("ok",([(Apply_Method mI, Apply_Method' (mI, SOME t, is, ctxt), |
162 ((lev_on p, Frm), is))], c, (pt,pos)):calcstate') |
162 ((lev_on p, Frm), (is, ctxt)))], c, (pt,pos)):calcstate') |
163 end |
163 end |
164 | NONE => (*execute the first tac in the Script, compare solve m*) |
164 | NONE => (*execute the first tac in the Script, compare solve m*) |
165 let val (m', is', _) = next_tac (thy', srls) (pt, (p, Res)) sc is; |
165 let val (m', (is', ctxt'), _) = next_tac (thy', srls) (pt, (p, Res)) sc (is, ctxt); |
166 val d = e_rls (*FIXME: get simplifier from domID*); |
166 val d = e_rls (*FIXME: get simplifier from domID*); |
167 in |
167 in |
168 case locate_gen (thy',srls) m' (pt,(p, Res))(sc,d) is' of |
168 case locate_gen (thy',srls) m' (pt,(p, Res))(sc,d) (is', ctxt') of |
169 Steps (is'', ss as (m'',f',pt',p',c')::_) => |
169 Steps (is'', ss as (m'',f',pt',p',c')::_) => |
170 (* val Steps (is'', ss as (m'',f',pt',p',c')::_) = |
170 (* val Steps (is'', ss as (m'',f',pt',p',c')::_) = |
171 locate_gen (thy',srls) m' (pt,(p,Res)) (sc,d) is'; |
171 locate_gen (thy',srls) m' (pt,(p,Res)) (sc,d) is'; |
172 *) |
172 *) |
173 ("ok", (map step2taci ss, c', (pt',p'))) |
173 ("ok", (map step2taci ss, c', (pt',p'))) |
174 | NotLocatable => |
174 | NotLocatable => |
175 let val (p,ps,f,pt) = |
175 let val (p,ps,f,pt) = |
176 generate_hard (assoc_thy "Isac") m (p,Frm) pt; |
176 generate_hard (assoc_thy "Isac") m (p,Frm) pt; |
177 in ("not-found-in-script", |
177 in ("not-found-in-script", |
178 ([(tac_2tac m, m, (pos, is))], ps, (pt,p))) end |
178 ([(tac_2tac m, m, (pos, (is, ctxt)))], ps, (pt,p))) end |
179 (*just-before------------------------------------------------------ |
179 (*just-before------------------------------------------------------ |
180 ("ok",([(Apply_Method mI,Apply_Method'(mI,NONE,e_istate), |
180 ("ok",([(Apply_Method mI,Apply_Method'(mI,NONE,e_istate), |
181 (pos, is))], |
181 (pos, is))], |
182 [], (update_env pt (fst pos) (SOME is),pos))) |
182 [], (update_env pt (fst pos) (SOME is),pos))) |
183 -----------------------------------------------------------------*) |
183 -----------------------------------------------------------------*) |
187 | solve ("Free_Solve", Free_Solve') (pt,po as (p,_)) = |
187 | solve ("Free_Solve", Free_Solve') (pt,po as (p,_)) = |
188 let (*val _=tracing"###solve Free_Solve";*) |
188 let (*val _=tracing"###solve Free_Solve";*) |
189 val p' = lev_dn_ (p,Res); |
189 val p' = lev_dn_ (p,Res); |
190 val pt = update_metID pt (par_pblobj pt p) e_metID; |
190 val pt = update_metID pt (par_pblobj pt p) e_metID; |
191 in ("ok", ((*(p',Uistate,Empty_Tac_), EmptyMout, Empty_Tac, Unsafe,*) |
191 in ("ok", ((*(p',Uistate,Empty_Tac_), EmptyMout, Empty_Tac, Unsafe,*) |
192 [(Empty_Tac, Empty_Tac_, (po, Uistate))], [], (pt,p'))) end |
192 [(Empty_Tac, Empty_Tac_, (po, (Uistate, e_ctxt)))], [], (pt,p'))) end |
193 |
193 |
194 (* val (("Check_Postcond",Check_Postcond' (pI,_)), (pt,(pos as (p,p_)))) = |
194 (* val (("Check_Postcond",Check_Postcond' (pI,_)), (pt,(pos as (p,p_)))) = |
195 ( m, (pt, pos)); |
195 ( m, (pt, pos)); |
196 *) |
196 *) |
197 | solve ("Check_Postcond",Check_Postcond' (pI,_)) (pt,(pos as (p,p_))) = |
197 | solve ("Check_Postcond",Check_Postcond' (pI,_)) (pt,(pos as (p,p_))) = |
202 (snd o (get_obj g_result pt)) p |
202 (snd o (get_obj g_result pt)) p |
203 | _ => ((map fst) o (get_assumptions_ pt)) (p,p_)) |
203 | _ => ((map fst) o (get_assumptions_ pt)) (p,p_)) |
204 handle _ => [] (*WN.27.5.03 asms in subpbls not completely clear*) |
204 handle _ => [] (*WN.27.5.03 asms in subpbls not completely clear*) |
205 val metID = get_obj g_metID pt pp; |
205 val metID = get_obj g_metID pt pp; |
206 val {srls=srls,scr=sc,...} = get_met metID; |
206 val {srls=srls,scr=sc,...} = get_met metID; |
207 val is as ScrState (E,l,a,_,_,b) = get_istate pt (p,p_); |
207 val (is as ScrState (E,l,a,_,_,b), ctxt) = get_istate pt (p,p_); |
208 (*val _= tracing("### solve Check_postc, subpbl pos= "^(pos'2str (p,p_))); |
208 (*val _= tracing("### solve Check_postc, subpbl pos= "^(pos'2str (p,p_))); |
209 val _= tracing("### solve Check_postc, is= "^(istate2str is));*) |
209 val _= tracing("### solve Check_postc, is= "^(istate2str is));*) |
210 val thy' = get_obj g_domID pt pp; |
210 val thy' = get_obj g_domID pt pp; |
211 val thy = assoc_thy thy'; |
211 val thy = assoc_thy thy'; |
212 val (_,_,(scval,scsaf)) = next_tac (thy',srls) (pt,(p,p_)) sc is; |
212 val (_,_,(scval,scsaf)) = next_tac (thy',srls) (pt,(p,p_)) sc (is, ctxt); |
213 (*val _= tracing("### solve Check_postc, scval= "^(term2str scval));*) |
213 (*val _= tracing("### solve Check_postc, scval= "^(term2str scval));*) |
214 |
214 |
215 in if pp = [] then |
215 in if pp = [] then |
216 let val is = ScrState (E,l,a,scval,scsaf,b) |
216 let val is = ScrState (E,l,a,scval,scsaf,b) |
217 val tac_ = Check_Postcond'(pI,(scval, map term2str asm)) |
217 val tac_ = Check_Postcond'(pI,(scval, map term2str asm)) |
218 val (pos,ps,f,pt) = generate1 thy tac_ is (pp,Res) pt; |
218 val (pos,ps,f,pt) = generate1 thy tac_ (is, ctxt) (pp,Res) pt; |
219 in ("ok", ((*(([],Res),is,End_Proof''), f, End_Proof', scsaf,*) |
219 in ("ok", ((*(([],Res),is,End_Proof''), f, End_Proof', scsaf,*) |
220 [(Check_Postcond pI, tac_, ((pp,Res),is))], ps,(pt,pos))) end |
220 [(Check_Postcond pI, tac_, ((pp,Res),(is, ctxt)))], ps,(pt,pos))) end |
221 else |
221 else |
222 let |
222 let |
223 (*resume script of parpbl, transfer value of subpbl-script*) |
223 (*resume script of parpbl, transfer value of subpbl-script*) |
224 val ppp = par_pblobj pt (lev_up p); |
224 val ppp = par_pblobj pt (lev_up p); |
225 val thy' = get_obj g_domID pt ppp; |
225 val thy' = get_obj g_domID pt ppp; |
226 val thy = assoc_thy thy'; |
226 val thy = assoc_thy thy'; |
227 val metID = get_obj g_metID pt ppp; |
227 val metID = get_obj g_metID pt ppp; |
228 val sc = (#scr o get_met) metID; |
228 val sc = (#scr o get_met) metID; |
229 val is as ScrState (E,l,a,_,_,b) = get_istate pt (pp(*!/p/*),Frm); |
229 val (is as ScrState (E,l,a,_,_,b), ctxt) = get_istate pt (pp(*!/p/*),Frm); |
230 (*val _=tracing("### solve Check_postc, parpbl pos= "^(pos'2str(pp,Frm))); |
230 (*val _=tracing("### solve Check_postc, parpbl pos= "^(pos'2str(pp,Frm))); |
231 val _=tracing("### solve Check_postc, is(pt)= "^(istate2str is)); |
231 val _=tracing("### solve Check_postc, is(pt)= "^(istate2str is)); |
232 val _=tracing("### solve Check_postc, is'= "^ |
232 val _=tracing("### solve Check_postc, is'= "^ |
233 (istate2str (E,l,a,scval,scsaf,b)));*) |
233 (istate2str (E,l,a,scval,scsaf,b)));*) |
234 val ((p,p_),ps,f,pt) = |
234 val ((p,p_),ps,f,pt) = |
235 generate1 thy (Check_Postcond' (pI, (scval, map term2str asm))) |
235 generate1 thy (Check_Postcond' (pI, (scval, map term2str asm))) |
236 (ScrState (E,l,a,scval,scsaf,b)) (pp,Res) pt; |
236 (ScrState (E,l,a,scval,scsaf,b), ctxt) (pp,Res) pt; |
237 (*val _=tracing("### solve Check_postc, is(pt')= "^ |
237 (*val _=tracing("### solve Check_postc, is(pt')= "^ |
238 (istate2str (get_istate pt ([3],Res)))); |
238 (istate2str (get_istate pt ([3],Res)))); |
239 val (nx,is',_) = next_tac (thy',srls) (pt,(p,p_)) sc |
239 val (nx,is',_) = next_tac (thy',srls) (pt,(p,p_)) sc |
240 (ScrState (E,l,a,scval,scsaf,b));*) |
240 (ScrState (E,l,a,scval,scsaf,b));*) |
241 in ("ok",(*((pp,Res),is',nx), f, tac_2tac nx, scsaf,*) |
241 in ("ok",(*((pp,Res),is',nx), f, tac_2tac nx, scsaf,*) |
242 ([(Check_Postcond pI, Check_Postcond'(pI,(scval, map term2str asm)), |
242 ([(Check_Postcond pI, Check_Postcond'(pI,(scval, map term2str asm)), |
243 ((pp,Res), ScrState (E,l,a,scval,scsaf,b)))],ps,(pt,(p,p_)))) |
243 ((pp,Res), (ScrState (E,l,a,scval,scsaf,b), ctxt)))],ps,(pt,(p,p_)))) |
244 end |
244 end |
245 end |
245 end |
246 (* val (msg, cs') = |
246 (* val (msg, cs') = |
247 ("ok",([(Check_Postcond pI,Check_Postcond'(pI, (scval, map term2str asm))), |
247 ("ok",([(Check_Postcond pI,Check_Postcond'(pI, (scval, map term2str asm))), |
248 ((pp,Res),(ScrState (E,l,a,scval,scsaf,b)))], (pt,(p,p_)))); |
248 ((pp,Res),(ScrState (E,l,a,scval,scsaf,b)))], (pt,(p,p_)))); |
254 (* tracing(istate2str(get_istate pt (p,p_))); |
254 (* tracing(istate2str(get_istate pt (p,p_))); |
255 *) |
255 *) |
256 | solve (_,End_Proof'') (pt, (p,p_)) = |
256 | solve (_,End_Proof'') (pt, (p,p_)) = |
257 ("end-proof", |
257 ("end-proof", |
258 ((*(([],Res),Uistate,Empty_Tac_), EmptyMout, Empty_Tac, Safe,*) |
258 ((*(([],Res),Uistate,Empty_Tac_), EmptyMout, Empty_Tac, Safe,*) |
259 [(Empty_Tac,Empty_Tac_,(([],Res),Uistate))],[],(pt,(p,p_)))) |
259 [(Empty_Tac,Empty_Tac_,(([],Res),(Uistate, e_ctxt)))],[],(pt,(p,p_)))) |
260 |
260 |
261 (*-----------vvvvvvvvvvv could be done by generate1 ?!?*) |
261 (*-----------vvvvvvvvvvv could be done by generate1 ?!?*) |
262 | solve (_,End_Detail' t) (pt,(p,p_)) = |
262 | solve (_,End_Detail' t) (pt,(p,p_)) = |
263 let val pr as (p',_) = (lev_up p, Res) |
263 let val pr as (p',_) = (lev_up p, Res) |
264 val pp = par_pblobj pt p |
264 val pp = par_pblobj pt p |
265 val r = (fst o (get_obj g_result pt)) p' |
265 val r = (fst o (get_obj g_result pt)) p' |
266 (*Rewrite_Set* done at Detail_Set*: this result is already in ptree*) |
266 (*Rewrite_Set* done at Detail_Set*: this result is already in ptree*) |
267 val thy' = get_obj g_domID pt pp |
267 val thy' = get_obj g_domID pt pp |
268 val (srls, is, sc) = from_pblobj' thy' pr pt |
268 val (srls, is, sc) = from_pblobj' thy' pr pt |
269 val (tac_,is',_) = next_tac (thy',srls) (pt,pr) sc is |
269 val (tac_,is',_) = next_tac (thy',srls) (pt,pr) sc is |
270 in ("ok", ((*((pp,Frm(*???*)),is,tac_), |
270 in ("ok", ((*((pp,Frm(*???*)),is,tac_), |
271 Form' (FormKF (~1, EdUndef, length p', Nundef, term2str r)), |
271 Form' (FormKF (~1, EdUndef, length p', Nundef, term2str r)), |
272 tac_2tac tac_, Sundef,*) |
272 tac_2tac tac_, Sundef,*) |
273 [(End_Detail, End_Detail' t , |
273 [(End_Detail, End_Detail' t , |
274 ((p,p_), get_istate pt (p,p_)))], [], (pt,pr))) end |
274 ((p,p_), get_istate pt (p,p_)))], [], (pt,pr))) end |
278 *) |
278 *) |
279 if e_metID = get_obj g_metID pt (par_pblobj pt p)(*29.8.02: |
279 if e_metID = get_obj g_metID pt (par_pblobj pt p)(*29.8.02: |
280 could be detail, too !!*) |
280 could be detail, too !!*) |
281 then let val ((p,p_),ps,f,pt) = |
281 then let val ((p,p_),ps,f,pt) = |
282 generate1 (assoc_thy (get_obj g_domID pt (par_pblobj pt p))) |
282 generate1 (assoc_thy (get_obj g_domID pt (par_pblobj pt p))) |
283 m e_istate (p,p_) pt; |
283 m (e_istate, e_ctxt) (p,p_) pt; |
284 in ("no-method-specified", (*Free_Solve*) |
284 in ("no-method-specified", (*Free_Solve*) |
285 ((*((p,p_),Uistate,Empty_Tac_),f, Empty_Tac, Unsafe,*) |
285 ((*((p,p_),Uistate,Empty_Tac_),f, Empty_Tac, Unsafe,*) |
286 [(Empty_Tac,Empty_Tac_, ((p,p_),Uistate))], ps, (pt,(p,p_)))) end |
286 [(Empty_Tac,Empty_Tac_, ((p,p_),(Uistate, e_ctxt)))], ps, (pt,(p,p_)))) end |
287 else |
287 else |
288 let |
288 let |
289 val thy' = get_obj g_domID pt (par_pblobj pt p); |
289 val thy' = get_obj g_domID pt (par_pblobj pt p); |
290 val (srls, is, sc) = from_pblobj_or_detail' thy' (p,p_) pt; |
290 val (srls, is, sc) = from_pblobj_or_detail' thy' (p,p_) pt; |
291 (*val _= tracing("### solve, before locate_gen p="^(pos'2str(p,p_)));*) |
291 (*val _= tracing("### solve, before locate_gen p="^(pos'2str(p,p_)));*) |
314 end; |
314 end; |
315 |
315 |
316 |
316 |
317 (*FIXME.WN050821 compare solve ... nxt_solv*) |
317 (*FIXME.WN050821 compare solve ... nxt_solv*) |
318 (* nxt_solv (Apply_Method' vvv FIXME: get args in applicable_in *) |
318 (* nxt_solv (Apply_Method' vvv FIXME: get args in applicable_in *) |
319 fun nxt_solv (Apply_Method' (mI,_,_)) _ (pt:ptree, pos as (p,_)) = |
319 fun nxt_solv (Apply_Method' (mI,_,_,_)) _ (pt:ptree, pos as (p,_)) = |
320 (* val ((Apply_Method' (mI,_,_)), _, (pt:ptree, pos as (p,_))) = |
320 (* val ((Apply_Method' (mI,_,_)), _, (pt:ptree, pos as (p,_))) = |
321 ((Apply_Method' (mI, NONE, e_istate)), e_istate, ptp); |
321 ((Apply_Method' (mI, NONE, e_istate)), e_istate, ptp); |
322 *) |
322 *) |
323 let val {srls,ppc,...} = get_met mI; |
323 let val {srls,ppc,...} = get_met mI; |
324 val PblObj{meth=itms,origin=(oris,_,_),probl,...} = get_obj I pt p; |
324 val PblObj{meth=itms,origin=(oris,_,_),probl,...} = get_obj I pt p; |
325 val itms = if itms <> [] then itms |
325 val itms = if itms <> [] then itms |
326 else complete_metitms oris probl [] ppc |
326 else complete_metitms oris probl [] ppc |
327 val thy' = get_obj g_domID pt p; |
327 val thy' = get_obj g_domID pt p; |
328 val thy = assoc_thy thy'; |
328 val thy = assoc_thy thy'; |
329 val (is as ScrState (env,_,_,_,_,_), scr) = init_scrstate thy itms mI; |
329 val (is as ScrState (env,_,_,_,_,_), ctxt, scr) = init_scrstate thy itms mI; |
330 val ini = init_form thy scr env; |
330 val ini = init_form thy scr env; |
331 in |
331 in |
332 case ini of |
332 case ini of |
333 SOME t => (* val SOME t = ini; |
333 SOME t => (* val SOME t = ini; |
334 *) |
334 *) |
335 let val pos = ((lev_on o lev_dn) p, Frm) |
335 let val pos = ((lev_on o lev_dn) p, Frm) |
336 val tac_ = Apply_Method' (mI, SOME t, is); |
336 val tac_ = Apply_Method' (mI, SOME t, is, ctxt); |
337 val (pos,c,_,pt) = (*implicit Take*) |
337 val (pos,c,_,pt) = (*implicit Take*) |
338 generate1 thy tac_ is pos pt |
338 generate1 thy tac_ (is, ctxt) pos pt |
339 (*val _= ("### nxt_solv Apply_Method, pos= "^pos'2str (lev_on p,Frm));*) |
339 (*val _= ("### nxt_solv Apply_Method, pos= "^pos'2str (lev_on p,Frm));*) |
340 in ([(Apply_Method mI, tac_, (pos, is))], c, (pt, pos)):calcstate' end |
340 in ([(Apply_Method mI, tac_, (pos, (is, ctxt)))], c, (pt, pos)):calcstate' end |
341 | NONE => |
341 | NONE => |
342 let val pt = update_env pt (fst pos) (SOME is) |
342 let val pt = update_env pt (fst pos) (SOME (is, ctxt)) |
343 val (tacis, c, ptp) = nxt_solve_ (pt, pos) |
343 val (tacis, c, ptp) = nxt_solve_ (pt, pos) |
344 in (tacis @ |
344 in (tacis @ |
345 [(Apply_Method mI, Apply_Method' (mI, NONE, e_istate), (pos, is))], |
345 [(Apply_Method mI, Apply_Method' (mI, NONE, e_istate, e_ctxt), (pos, (is, ctxt)))], |
346 c, ptp) end |
346 c, ptp) end |
347 end |
347 end |
348 (* val ("Check_Postcond",Check_Postcond' (pI,_)) = (mI,m); |
348 (* val ("Check_Postcond",Check_Postcond' (pI,_)) = (mI,m); |
349 val (Check_Postcond' (pI,_), _, (pt, pos as (p,p_))) = |
349 val (Check_Postcond' (pI,_), _, (pt, pos as (p,p_))) = |
350 (tac_, is, ptp); |
350 (tac_, is, ptp); |
358 (snd o (get_obj g_result pt)) p |
358 (snd o (get_obj g_result pt)) p |
359 | _ => ((map fst) o (get_assumptions_ pt)) (p,p_)) |
359 | _ => ((map fst) o (get_assumptions_ pt)) (p,p_)) |
360 handle _ => [] (*WN.27.5.03 asms in subpbls not completely clear*) |
360 handle _ => [] (*WN.27.5.03 asms in subpbls not completely clear*) |
361 val metID = get_obj g_metID pt pp; |
361 val metID = get_obj g_metID pt pp; |
362 val {srls=srls,scr=sc,...} = get_met metID; |
362 val {srls=srls,scr=sc,...} = get_met metID; |
363 val is as ScrState (E,l,a,_,_,b) = get_istate pt (p,p_); |
363 val (is as ScrState (E,l,a,_,_,b), ctxt) = get_istate pt (p,p_); |
364 (*val _= tracing("### solve Check_postc, subpbl pos= "^(pos'2str (p,p_))); |
364 (*val _= tracing("### solve Check_postc, subpbl pos= "^(pos'2str (p,p_))); |
365 val _= tracing("### solve Check_postc, is= "^(istate2str is));*) |
365 val _= tracing("### solve Check_postc, is= "^(istate2str is));*) |
366 val thy' = get_obj g_domID pt pp; |
366 val thy' = get_obj g_domID pt pp; |
367 val thy = assoc_thy thy'; |
367 val thy = assoc_thy thy'; |
368 val (_,_,(scval,scsaf)) = next_tac (thy',srls) (pt,(p,p_)) sc is; |
368 val (_,_,(scval,scsaf)) = next_tac (thy',srls) (pt,(p,p_)) sc (is, ctxt); |
369 (*val _= tracing("### solve Check_postc, scval= "^(term2str scval));*) |
369 (*val _= tracing("### solve Check_postc, scval= "^(term2str scval));*) |
370 in if pp = [] then |
370 in if pp = [] then |
371 let val is = ScrState (E,l,a,scval,scsaf,b) |
371 let val is = ScrState (E,l,a,scval,scsaf,b) |
372 val tac_ = Check_Postcond'(pI,(scval, map term2str asm)) |
372 val tac_ = Check_Postcond'(pI,(scval, map term2str asm)) |
373 (*val _= tracing"### nxt_solv2 Apply_Method: stored is ="; |
373 (*val _= tracing"### nxt_solv2 Apply_Method: stored is ="; |
374 val _= tracing(istate2str is);*) |
374 val _= tracing(istate2str is);*) |
375 val ((p,p_),ps,f,pt) = |
375 val ((p,p_),ps,f,pt) = |
376 generate1 thy tac_ is (pp,Res) pt; |
376 generate1 thy tac_ (is, ctxt) (pp,Res) pt; |
377 in ([(Check_Postcond pI, tac_, ((pp,Res), is))],ps,(pt, (p,p_))) end |
377 in ([(Check_Postcond pI, tac_, ((pp,Res), (is, ctxt)))],ps,(pt, (p,p_))) end |
378 else |
378 else |
379 let |
379 let |
380 (*resume script of parpbl, transfer value of subpbl-script*) |
380 (*resume script of parpbl, transfer value of subpbl-script*) |
381 val ppp = par_pblobj pt (lev_up p); |
381 val ppp = par_pblobj pt (lev_up p); |
382 val thy' = get_obj g_domID pt ppp; |
382 val thy' = get_obj g_domID pt ppp; |
383 val thy = assoc_thy thy'; |
383 val thy = assoc_thy thy'; |
384 val metID = get_obj g_metID pt ppp; |
384 val metID = get_obj g_metID pt ppp; |
385 val {scr,...} = get_met metID; |
385 val {scr,...} = get_met metID; |
386 val is as ScrState (E,l,a,_,_,b) = get_istate pt (pp(*!/p/*),Frm) |
386 val (is as ScrState (E,l,a,_,_,b), ctxt) = get_istate pt (pp(*!/p/*),Frm) |
387 val tac_ = Check_Postcond' (pI, (scval, map term2str asm)) |
387 val tac_ = Check_Postcond' (pI, (scval, map term2str asm)) |
388 val is = ScrState (E,l,a,scval,scsaf,b) |
388 val is = ScrState (E,l,a,scval,scsaf,b) |
389 (*val _= tracing"### nxt_solv3 Apply_Method: stored is ="; |
389 (*val _= tracing"### nxt_solv3 Apply_Method: stored is ="; |
390 val _= tracing(istate2str is);*) |
390 val _= tracing(istate2str is);*) |
391 val ((p,p_),ps,f,pt) = generate1 thy tac_ is (pp, Res) pt; |
391 val ((p,p_),ps,f,pt) = generate1 thy tac_ (is, ctxt) (pp, Res) pt; |
392 (*val (nx,is',_) = next_tac (thy',srls) (pt,(p,p_)) scr is;WN050913*) |
392 (*val (nx,is',_) = next_tac (thy',srls) (pt,(p,p_)) scr is;WN050913*) |
393 in ([(Check_Postcond pI, tac_, ((pp, Res), is))], ps, (pt, (p,p_))) end |
393 in ([(Check_Postcond pI, tac_, ((pp, Res), (is, ctxt)))], ps, (pt, (p,p_))) end |
394 end |
394 end |
395 (* tracing(istate2str(get_istate pt (p,p_))); |
395 (* tracing(istate2str(get_istate pt (p,p_))); |
396 *) |
396 *) |
397 |
397 |
398 (*.start interpreter and do one rewrite.*) |
398 (*.start interpreter and do one rewrite.*) |
501 (* val (ptp as (pt, (p,_))) = ptp; |
501 (* val (ptp as (pt, (p,_))) = ptp; |
502 val (ptp as (pt, (p,_))) = ptp'; |
502 val (ptp as (pt, (p,_))) = ptp'; |
503 val (ptp as (pt, (p,_))) = (pt, pos); |
503 val (ptp as (pt, (p,_))) = (pt, pos); |
504 *) |
504 *) |
505 let val (_,_,mI) = get_obj g_spec pt p; |
505 let val (_,_,mI) = get_obj g_spec pt p; |
506 val (_, c', ptp) = nxt_solv (Apply_Method' (mI, NONE, e_istate)) |
506 val (_, c', ptp) = nxt_solv (Apply_Method' (mI, NONE, e_istate, e_ctxt)) |
507 e_istate ptp; |
507 (e_istate, e_ctxt) ptp; |
508 in complete_solve auto (c@c') ptp end; |
508 in complete_solve auto (c@c') ptp end; |
509 (*@@@ vvv @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*) |
509 (*@@@ vvv @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*) |
510 fun complete_solve auto c (ptp as (_, p as (_,p_)): ptree * pos') = |
510 fun complete_solve auto c (ptp as (_, p as (_,p_)): ptree * pos') = |
511 if p = ([], Res) then ("end-of-calculation", [], ptp) else |
511 if p = ([], Res) then ("end-of-calculation", [], ptp) else |
512 if member op = [Pbl,Met] p_ |
512 if member op = [Pbl,Met] p_ |
526 if autoord auto < 6 then ("ok", c@c', ptp') |
526 if autoord auto < 6 then ("ok", c@c', ptp') |
527 else complete_solve auto (c@c') ptp' |
527 else complete_solve auto (c@c') ptp' |
528 | (_, c', ptp') => complete_solve auto (c@c') ptp' |
528 | (_, c', ptp') => complete_solve auto (c@c') ptp' |
529 and all_solve auto c (ptp as (pt, (p,_)): ptree * pos') = |
529 and all_solve auto c (ptp as (pt, (p,_)): ptree * pos') = |
530 let val (_,_,mI) = get_obj g_spec pt p |
530 let val (_,_,mI) = get_obj g_spec pt p |
531 val (_, c', ptp) = nxt_solv (Apply_Method' (mI, NONE, e_istate)) |
531 val (_, c', ptp) = nxt_solv (Apply_Method' (mI, NONE, e_istate, e_ctxt)) |
532 e_istate ptp |
532 (e_istate, e_ctxt) ptp |
533 in complete_solve auto (c@c') ptp end; |
533 in complete_solve auto (c@c') ptp end; |
534 |
534 |
535 (*.aux.fun for detailrls with Rrls, reverse rewriting.*) |
535 (*.aux.fun for detailrls with Rrls, reverse rewriting.*) |
536 (* val (nds, t, ((rule, (t', asm)) :: rts)) = ([], t, rul_terms); |
536 (* val (nds, t, ((rule, (t', asm)) :: rts)) = ([], t, rul_terms); |
537 *) |
537 *) |
538 fun rul_terms_2nds nds t [] = nds |
538 fun rul_terms_2nds nds t [] = nds |
539 | rul_terms_2nds nds t ((rule, res as (t', _)) :: rts) = |
539 | rul_terms_2nds nds t ((rule, res as (t', _)) :: rts) = |
540 (append_atomic [] e_istate t (rule2tac [] rule) res Complete EmptyPtree) :: |
540 (append_atomic [] (e_istate, e_ctxt) t (rule2tac [] rule) res Complete EmptyPtree) :: |
541 (rul_terms_2nds nds t' rts); |
541 (rul_terms_2nds nds t' rts); |
542 |
542 |
543 |
543 |
544 (*. detail steps done internally by Rewrite_Set* |
544 (*. detail steps done internally by Rewrite_Set* |
545 into ctree by use of a script .*) |
545 into ctree by use of a script .*) |
560 | _ => |
560 | _ => |
561 let val is = init_istate tac t |
561 let val is = init_istate tac t |
562 (*TODO.WN060602 ScrState (["(t_, Problem (Isac,[equation,univar]))"] |
562 (*TODO.WN060602 ScrState (["(t_, Problem (Isac,[equation,univar]))"] |
563 is wrong for simpl, but working ?!? *) |
563 is wrong for simpl, but working ?!? *) |
564 val tac_ = Apply_Method' (e_metID(*WN0402: see generate1 !?!*), |
564 val tac_ = Apply_Method' (e_metID(*WN0402: see generate1 !?!*), |
565 SOME t, is) |
565 SOME t, is, e_ctxt) |
566 val pos' = ((lev_on o lev_dn) p, Frm) |
566 val pos' = ((lev_on o lev_dn) p, Frm) |
567 val thy = assoc_thy "Isac" |
567 val thy = assoc_thy "Isac" |
568 val (_,_,_,pt') = (*implicit Take*)generate1 thy tac_ is pos' pt |
568 val (_,_,_,pt') = (*implicit Take*)generate1 thy tac_ (is, e_ctxt) pos' pt |
569 val (_,_,(pt'',_)) = complete_solve CompleteSubpbl [] (pt',pos') |
569 val (_,_,(pt'',_)) = complete_solve CompleteSubpbl [] (pt',pos') |
570 val newnds = children (get_nd pt'' p) |
570 val newnds = children (get_nd pt'' p) |
571 val pt''' = ins_chn newnds pt p |
571 val pt''' = ins_chn newnds pt p |
572 (*complete_solve cuts branches after*) |
572 (*complete_solve cuts branches after*) |
573 in ("detailrls", pt'''(*, get_formress [] ((lev_on o lev_dn) p)cn*), |
573 in ("detailrls", pt'''(*, get_formress [] ((lev_on o lev_dn) p)cn*), |