intermed. ctxt ..: add preconds in solve..Apply_Method decompose-isar
authorWalther Neuper <neuper@ist.tugraz.at>
Thu, 19 May 2011 19:28:22 +0200
branchdecompose-isar
changeset 420095f5807893ceb
parent 42008 384eede0e288
child 42010 85ce1938a811
intermed. ctxt ..: add preconds in solve..Apply_Method
doc-src/isac/master_thesis_template.zip
src/Tools/isac/Interpret/ctree.sml
src/Tools/isac/Interpret/mathengine.sml
src/Tools/isac/Interpret/mstools.sml
test/Tools/isac/Minisubpbl/200-start-method.sml
test/Tools/isac/Minisubpbl/600-postcond.sml
test/Tools/isac/Test_Isac.thy
     1.1 Binary file doc-src/isac/master_thesis_template.zip has changed
     2.1 --- a/src/Tools/isac/Interpret/ctree.sml	Wed May 18 16:06:00 2011 +0200
     2.2 +++ b/src/Tools/isac/Interpret/ctree.sml	Thu May 19 19:28:22 2011 +0200
     2.3 @@ -1247,7 +1247,6 @@
     2.4      let val ppobj = get_obj I pt p
     2.5      in is_pblobj ppobj end;
     2.6  
     2.7 -
     2.8  fun delete_result pt (p:pos) =
     2.9      (appl_obj (repl_result (fst (get_obj g_loc pt p), NONE) 
    2.10  			   (e_term,[]) Incomplete) pt p);
    2.11 @@ -1262,12 +1261,8 @@
    2.12      PrfObj {cell=cell,form=form,tac=tac, loc=(l1,NONE), branch=branch, 
    2.13  	    result=(e_term,[]), ostate=Incomplete};
    2.14  
    2.15 -
    2.16 -(*
    2.17 -fun update_fmz  pt pos x = appl_obj (repl_fmz  x) pt pos;
    2.18 -                                       1.00 not used anymore*)
    2.19 -
    2.20 -(*FIXME.WN.12.03: update_X X pos pt -> pt could be chained by o (efficiency?)*)
    2.21 +(*FIXME.WN0312 update_X X pos pt -> pt could be chained by o (efficiency?)*)
    2.22 +(*fun update_fmz  pt pos x = appl_obj (repl_fmz  x) pt pos; WN01xx *)
    2.23  fun update_ctxt   pt pos x = appl_obj (repl_ctxt   x) pt pos; (*for use on PblObj, 
    2.24  otherwise use fun generate1; compare fun get_ctxt*)
    2.25  fun update_env    pt pos x = appl_obj (repl_env    x) pt pos;
    2.26 @@ -1282,10 +1277,10 @@
    2.27  fun update_branch pt pos x = appl_obj (repl_branch x) pt pos;
    2.28  fun update_tac    pt pos x = appl_obj (repl_tac    x) pt pos;
    2.29  fun update_oris   pt pos x = appl_obj (repl_oris   x) pt pos;
    2.30 -fun update_orispec   pt pos x = appl_obj (repl_orispec   x) pt pos;
    2.31 +fun update_orispec pt pos x = appl_obj (repl_orispec   x) pt pos;
    2.32  
    2.33 -(*WN050305 for handling cut_tree in cappend_atomic -- TODO redesign !*)
    2.34 -fun update_loc' pt p iss = appl_obj (repl_loc iss) pt p;
    2.35 +(*WN050305 for handling cut_tree in cappend_atomic + for testing*)
    2.36 +fun update_loc'   pt pos x = appl_obj (repl_loc    x) pt pos;
    2.37  
    2.38  (*13.8.02: options, because istate is no equalitype any more*)
    2.39  fun get_loc EmptyPtree _ = (e_istate, e_ctxt)
     3.1 --- a/src/Tools/isac/Interpret/mathengine.sml	Wed May 18 16:06:00 2011 +0200
     3.2 +++ b/src/Tools/isac/Interpret/mathengine.sml	Thu May 19 19:28:22 2011 +0200
     3.3 @@ -125,7 +125,7 @@
     3.4  		            | UNsafe cs' => ("unsafe-ok", cs')
     3.5  		            | Updated (cs' as (_,_,(_,p'))) => (*ev.SEVER.tacs like Begin_Trans*)
     3.6  		                (if p' = ([],Res) then "end-of-calculation" else "ok", cs')
     3.7 -                    (*for SEVER.tacs  user to ask ? *)
     3.8 +                    (*for SEVER.tacs user to ask ? *)
     3.9  	           end
    3.10        end;
    3.11  
    3.12 @@ -403,7 +403,7 @@
    3.13  	    | ("not-applicable",_) => (pt, p)
    3.14  	    | ("end-of-calculation", (_, _, ptp)) => ptp
    3.15  	    | ("failure",_) => error "sys-error";
    3.16 -	  val (_, ts) = (*WN101102 NOT tested, if step would create _same_ ptp*)
    3.17 +	  val (_, ts) = (*WN101102 TODO: locatetac + step create _same_ (pt,p) ?*)
    3.18  	    (case step p ((pt, e_pos'),[]) of
    3.19  		    ("ok", (ts as (tac,_,_)::_, _, _)) => ("",ts)
    3.20  	    | ("helpless",_) => ("helpless: cannot propose tac", [])
    3.21 @@ -414,8 +414,7 @@
    3.22        case ts of 
    3.23          tacis as (_::_) => let val (tac,_,_) = last_elem tacis in tac end 
    3.24  		  | _ => if p = ([],Res) then End_Proof' else Empty_Tac;
    3.25 -      (*form output comes from locatetac*)
    3.26 -  in (p:pos', []:NEW, TESTg_form (pt, p), 
    3.27 +  in (p:pos', []:NEW, TESTg_form (pt, p) (*form output comes from locatetac*), 
    3.28  	   (tac2IDstr tac, tac):tac'_, Sundef, pt) end;
    3.29  
    3.30  (*for quick test-print-out, until 'type inout' is removed*)
     4.1 --- a/src/Tools/isac/Interpret/mstools.sml	Wed May 18 16:06:00 2011 +0200
     4.2 +++ b/src/Tools/isac/Interpret/mstools.sml	Thu May 19 19:28:22 2011 +0200
     4.3 @@ -960,12 +960,9 @@
     4.4  fun pre2str (b, t) = pair2str(bool2str b, term2str t);
     4.5  fun pres2str pres = strs2str' (map (linefeed o pre2str) pres);
     4.6  
     4.7 -(*. check preconditions, return true if all true .*)
     4.8 +(* check preconditions, return true if all true *)
     4.9  fun check_preconds' _ [] _ _ = []  (*empty preconditions are true*)
    4.10    | check_preconds' prls pres pbl _(*FIXME.WN0308 mvat re-introduce*) =
    4.11 -(* val (prls, pres, pbl, _) = (prls, where_, probl, 0);
    4.12 -   val (prls, pres, pbl, _) = (prls, pre, itms, mvat);
    4.13 -   *)
    4.14      let val env = mk_env pbl;
    4.15          val pres' = map (subst_atomic_all env) pres;
    4.16      in map (evalprecond prls) pres' end;
    4.17 @@ -1012,6 +1009,7 @@
    4.18    fun insert_environments envs = map (fn t => Env t) envs |> insert_ctxt;
    4.19  end
    4.20  
    4.21 +(* transfer information set by Variable.declare_constraints *)
    4.22  fun transfer_from_subproblem ctxt_sub ctxt =
    4.23    insert_assumptions (get_assumptions ctxt_sub) ctxt;
    4.24  
     5.1 --- a/test/Tools/isac/Minisubpbl/200-start-method.sml	Wed May 18 16:06:00 2011 +0200
     5.2 +++ b/test/Tools/isac/Minisubpbl/200-start-method.sml	Thu May 19 19:28:22 2011 +0200
     5.3 @@ -15,7 +15,31 @@
     5.4  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
     5.5  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
     5.6  val (p,_,f,nxt,_,pt) = me nxt p [] pt; (*nxt = ("Apply_Method"*)
     5.7 -val (p,_,f,nxt,_,pt) = me nxt p [] pt; (*nxt = ("Rewrite_Set"*)
     5.8 +val (pt'''', p'''') = (pt, p);
     5.9 +"~~~~~ fun me, args:"; val (_,tac) = nxt;
    5.10 +"~~~~~ fun locatetac, args:"; val ptp as (pt, p) = (pt, p);
    5.11 +val (mI,m) = mk_tac'_ tac;
    5.12 +val Appl m = applicable_in p pt m;
    5.13 +member op = specsteps mI; (*false*)
    5.14 +"~~~~~ fun loc_solve_, args:"; val (m, (pt, pos) ) = ((mI, m), ptp);
    5.15 +"~~~~~ fun solve, args:"; val (("Apply_Method", Apply_Method' (mI,_,_,_)), pos as (p,_)) = (m, pos);
    5.16 +val PblObj {meth, ctxt, ...} = get_obj I pt p;
    5.17 +val thy' = get_obj g_domID pt p;
    5.18 +val thy = assoc_thy thy';
    5.19 +val {srls, pre, prls, ...} = get_met mI;
    5.20 +val pres = check_preconds thy prls pre meth |> map snd;
    5.21 +val ctxt = ctxt |> insert_assumptions pres;
    5.22 +val (is as ScrState (env,_,_,_,_,_), _, sc) = init_scrstate thy meth mI;
    5.23 +val ini = init_form thy sc env;
    5.24 +val p = lev_dn p;
    5.25 +val SOME t = ini;
    5.26 +val (pos,c,_,pt) = 
    5.27 +		  generate1 thy (Apply_Method' (mI, SOME t, is, ctxt))
    5.28 +			    (is, ctxt) (lev_on p, Frm)(*implicit Take*) pt;
    5.29 +("ok",([(Apply_Method mI, Apply_Method' (mI, SOME t, is, ctxt), 
    5.30 +		    ((lev_on p, Frm), (is, ctxt)))], c, (pt,pos)):calcstate');
    5.31 +
    5.32 +val (p,_,f,nxt,_,pt) = me nxt p'''' [] pt''''; (*nxt = ("Rewrite_Set"*)
    5.33  case nxt of ("Rewrite_Set", _) => ()
    5.34  | _ => error "minisubpbl: Method not started in root-problem";
    5.35  
     6.1 --- a/test/Tools/isac/Minisubpbl/600-postcond.sml	Wed May 18 16:06:00 2011 +0200
     6.2 +++ b/test/Tools/isac/Minisubpbl/600-postcond.sml	Thu May 19 19:28:22 2011 +0200
     6.3 @@ -1,4 +1,4 @@
     6.4 -(* Title:  500-postcond.sml
     6.5 +(* Title:  600-postcond.sml
     6.6     Author: Walther Neuper 1105
     6.7     (c) copyright due to lincense terms.
     6.8  *)
     7.1 --- a/test/Tools/isac/Test_Isac.thy	Wed May 18 16:06:00 2011 +0200
     7.2 +++ b/test/Tools/isac/Test_Isac.thy	Thu May 19 19:28:22 2011 +0200
     7.3 @@ -104,13 +104,6 @@
     7.4    ML {*"%%%%%%%%%%%%%%%%% end Minisubpbl %%%%%%%%%%%%%%%%%%%%%%%";*}
     7.5    ML {*"%%%%%%%%%%%%%%%%% start Interpret.thy %%%%%%%%%%%%%%%%%%";*}
     7.6    use "Interpret/mstools.sml"       (*new 2010*)
     7.7 -ML {*
     7.8 -(*test/../ctree.sml*)
     7.9 -val pt = EmptyPtree;
    7.10 -val pt = append_problem [] (e_istate, e_ctxt) e_fmz ([(*oris*)], e_spec, e_term) pt;
    7.11 -val ctxt = get_obj g_ctxt pt [];
    7.12 -if is_e_ctxt ctxt then () else error "TODO";
    7.13 -*}
    7.14    use "Interpret/ctree.sml"         (*!...!see(25)*)
    7.15    use "Interpret/ptyps.sml"         (*    *)
    7.16  (*use "Interpret/generate.sml"        new 2011*)
    7.17 @@ -178,6 +171,16 @@
    7.18    ("Test", ["sqroot-test","univariate","equation","test"],
    7.19     ["Test","squ-equ-test-subpbl1"]);
    7.20  val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
    7.21 +
    7.22 +"=(1)= variables known from root-fmz provide type-inference in further input";
    7.23 +val ctxt = get_ctxt pt p;
    7.24 +val SOME known_x = parseNEW ctxt "x+z+z";
    7.25 +val SOME unknown = parseNEW ctxt "xa+b+c";
    7.26 +if type_of known_x = Type ("RealDef.real",[]) then ()
    7.27 +else error "x+1=2 after start root-pbl wrong type-inference for known_x";
    7.28 +if  type_of unknown = TFree ("'a", ["Groups.plus"]) then ()
    7.29 +else error "x+1=2 after start root-pbl wrong type-inference for unknown";
    7.30 +
    7.31  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
    7.32  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
    7.33  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
    7.34 @@ -186,9 +189,24 @@
    7.35  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
    7.36  val (p,_,f,nxt,_,pt) = me nxt p [] pt; (*nxt = Apply_Method ["Test", "squ-equ-test-subpbl1"]*)
    7.37  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
    7.38 +*}
    7.39 +ML {*
    7.40 +"=(2)= preconds of (root-)met are known at start of lucas-interpreter";
    7.41 +if get_assumptions_ pt p = [(*str2term "precond_rootmet x"*)] then ((*!!!!!!!!!!!!!!!!*))
    7.42 +else error "x+1=2 after start root-met no precondition";
    7.43  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
    7.44  val (p,_,f,nxt,_,pt) = me nxt p [] pt; (*nxt = Subp ["linear", "univariate", "equation", "test"]*)
    7.45  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
    7.46 +
    7.47 +"=(3)= variables known from sub-fmz provide type-inference in further input";
    7.48 +val ctxt = get_ctxt pt p;
    7.49 +val SOME known_x = parseNEW ctxt "x+z+z"; (*x has declare_constraints to real*)
    7.50 +val SOME unknown = parseNEW ctxt "a+b+c";
    7.51 +if type_of known_x = Type ("RealDef.real",[]) then ()
    7.52 +else error "x+1=2 after start root-pbl wrong type-inference for known_x";
    7.53 +if  type_of unknown = TFree ("'a", ["Groups.plus"]) then ()
    7.54 +else error "x+1=2 after start root-pbl wrong type-inference for unknown";
    7.55 +
    7.56  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
    7.57  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
    7.58  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
    7.59 @@ -197,27 +215,137 @@
    7.60  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
    7.61  val (p,_,f,nxt,_,pt) = me nxt p [] pt; (*nxt = Apply_Method ["Test", "solve_linear"]*)
    7.62  val (p,_,f,nxt,_,pt) = me nxt p [] pt; 
    7.63 +*}
    7.64 +ML {*
    7.65 +"=(4)= preconds of (sub-)met are known at start of lucas-interpreter";
    7.66 +(*del GOON*)terms2strs (get_assumptions_ pt p);
    7.67 +*}
    7.68 +ML {*
    7.69 +if get_assumptions_ pt p =
    7.70 +  [(*parse_patt @{theory} "matches (?a = ?b) (-1 + x = 0)"*)
    7.71 +   (*, precond-rootmet, precond_submet*)] then ()
    7.72 +else error "x+1=2 after start sub-met no precondition";
    7.73 +*}
    7.74 +ML {*
    7.75  val (p,_,f,nxt,_,pt) = me nxt p [] pt; 
    7.76 +
    7.77 +"prep =(5)=: inject assumptions into sub-met: sub_asm_out, sub_asm_local";
    7.78 +val (SOME (iform, cform), SOME (ires, cres)) = get_obj g_loc pt (fst p);
    7.79 +val ctxt = insert_assumptions [str2term "x < sub_asm_out", str2term "a < sub_asm_local"] cres;
    7.80 +val pt = update_loc' pt (fst p) (SOME (iform, cform), SOME (ires, ctxt));
    7.81 +
    7.82  val (p,_,f,nxt,_,pt) = me nxt p [] pt; (*nxt = Check_Postcond ["linear","univariate", ...]) *);
    7.83 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
    7.84 +*}
    7.85 +ML {*
    7.86 +"=(5)= transfer of non-local assumptions from sub-met to root-met";
    7.87 +(*del*)terms2strs (get_assumptions_ pt p);
    7.88 +get_assumptions_ pt p = [(*precond_rootmet, precond_submet, sub_asm_out, sub_res*)];
    7.89 +(*del*)terms2strs (get_assumptions_ pt p);
    7.90 +terms2strs (get_assumptions_ pt p);
    7.91 +*}
    7.92 +ML {*
    7.93 +val (p,_,f,nxt,_,pt) = me nxt p [] pt; (*nxt=Check_P["sqroot-test","univariate","equation","test"*)
    7.94 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
    7.95 +*}
    7.96 +ML {*
    7.97 +"=(6)= assumptions collected during lucas-interpretation for proving postcondition";
    7.98 +get_assumptions_ pt p = [(*precond_rootmet, precond_submet, sub_asm_out, sub_res, root_res*)];
    7.99 +terms2strs (get_assumptions_ pt p);
   7.100  *}
   7.101  
   7.102  ML {*
   7.103 +(*############################################################################*)
   7.104  *}
   7.105  ML {*
   7.106 -val t = str2term "precond_rootmet x";
   7.107 -val SOME (s, t') = eval_precond_rootmet "precond_rootmet_" 0 t @{theory};
   7.108 -term2str t'
   7.109 +(*Minisubplb/500-met-sub-to-root.sml*)
   7.110 +val fmz = ["equality (x+1=(2::real))", "solveFor x","solutions L"];
   7.111 +val (dI',pI',mI') =
   7.112 +   ("Test", ["sqroot-test","univariate","equation","test"],
   7.113 +    ["Test","squ-equ-test-subpbl1"]);
   7.114 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
   7.115 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
   7.116 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
   7.117 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
   7.118 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
   7.119 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
   7.120 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
   7.121 +val (p,_,f,nxt,_,pt) = me nxt p [] pt; (*nxt = Apply_Method ["Test", "squ-equ-test-subpbl1"]*)
   7.122 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
   7.123 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
   7.124 +val (p,_,f,nxt,_,pt) = me nxt p [] pt; (*nxt = Subp ["linear", "univariate", "equation", "test"]*)
   7.125 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
   7.126 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
   7.127 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
   7.128 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
   7.129 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
   7.130 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
   7.131 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
   7.132 +val (p,_,f,nxt,_,pt) = me nxt p [] pt; (*nxt = Apply_Method ["Test", "solve_linear"]*)
   7.133 +val (p,_,f,nxt,_,pt) = me nxt p'' [] pt''; (*nxt = Rewrite_Set_Inst isolate_bdv*);
   7.134 +get_ctxt pt p |> is_e_ctxt;       (*false*)
   7.135 +val ctxt = get_ctxt pt p; 
   7.136 +val SOME t = parseNEW ctxt "Check_elementwise [x = 1] {(v_v::real). Assumptions}";
   7.137 +get_loc pt p |> snd |> is_e_ctxt; (*false*)
   7.138 +val (p,_,f,nxt,_,pt) = me nxt p [] pt; (*nxt = Rewrite_Set "Test_simplify"*);
   7.139 +get_ctxt pt p |> is_e_ctxt;       (*false*)
   7.140 +val ctxt = get_ctxt pt p; 
   7.141 +val SOME t = parseNEW ctxt "Check_elementwise [x = 1] {(v_v::real). Assumptions}";
   7.142 +get_loc pt p |> snd |> is_e_ctxt; (*false*)
   7.143 +val (p,_,f,nxt,_,pt) = me nxt p [] pt; (*nxt = Check_Postcond ["linear","univariate", ...]) *);
   7.144 +val (pt'''', p'''') = (pt, p);
   7.145  *}
   7.146  ML {*
   7.147 +locatetac tac (pt,p)
   7.148  *}
   7.149  ML {*
   7.150 +"~~~~~ fun me, args:"; val (_,tac) = nxt;
   7.151 +val (pt, p) = case locatetac tac (pt,p) of
   7.152 +	("ok", (_, _, ptp))  => ptp | _ => error "script.sml locatetac";
   7.153  *}
   7.154  ML {*
   7.155 +show_pt pt; (*...(([3], Res), [x = 1])]... back in root, OK *)
   7.156 +"~~~~~ fun step, args:"; val (ip as (_,p_), (ptp as (pt,p), tacis)) = (p, ((pt, e_pos'), []))
   7.157 +val pIopt = get_pblID (pt,ip); (*= SOME ["sqroot-test", "univariate", ...]*)
   7.158 +tacis; (*= []*)
   7.159 +member op = [Pbl,Met] p_ andalso is_none (get_obj g_env pt (fst p)); (*= false*)
   7.160  *}
   7.161  ML {*
   7.162 -
   7.163 +"~~~~~ fun nxt_solve_, args:"; val (ptp as (pt, pos as (p, p_))) = (pt, ip);
   7.164 +val thy' = get_obj g_domID pt (par_pblobj pt p);
   7.165 +val (srls, is, sc) = from_pblobj_or_detail' thy' (p,p_) pt; (*is: which ctxt?*)
   7.166 +"~~~~~ fun next_tac, args:"; val (thy, (ptp as (pt, pos as (p, _)):ptree * pos'), (sc as Script (h $ body)), 
   7.167 +	                               (ScrState (E,l,a,v,s,b), ctxt)) = ((thy',srls), (pt,pos), sc, is);
   7.168 +val ctxt = get_ctxt pt pos
   7.169 +val SOME t = parseNEW ctxt "Check_elementwise [x = 1] {(v_v::real). Assumptions}";
   7.170 +l; (*= [R, R, D, L, R]*)
   7.171 +"~~~~~ fun nstep_up, args:"; val (thy, ptp, (Script sc), E, l, ay, a, v) =
   7.172 +                                 (thy, ptp, sc, E, l, Skip_, a, v);
   7.173 +1 < length l; (*true*)
   7.174 +val up = drop_last l;
   7.175 +go up sc; (* = Const ("HOL.Let", *)
   7.176  *}
   7.177 -
   7.178 +ML {*
   7.179 +"~~~~~ fun nxt_up, args:"; val (thy, ptp, (scr as (Script sc)), E, l, ay,
   7.180 +                                      (t as Const ("HOL.Let",_) $ _), a, v) =
   7.181 +                            (thy, ptp, (Script sc), E, up, ay, (go up sc), a, v);
   7.182 +ay = Napp_; (*false*)
   7.183 +val up = drop_last l;
   7.184 +val (Const ("HOL.Let",_) $ e $ (Abs (i,T,body))) = go up sc;
   7.185 +val i = mk_Free (i, T);
   7.186 +val E = upd_env E (i, v);
   7.187 +body; (*= Const ("Script.Check'_elementwise"*)
   7.188 +"~~~~~ fun appy, args:"; val ((thy as (th,sr)), (pt, p), E, l, t, a, v)=
   7.189 +                              (thy, ptp, E, (up@[R,D]), body, a, v);
   7.190 +handle_leaf "next  " th sr E a v t; (*= (NONE, STac (Const ("Script.Check'_elementwise"*)
   7.191 +val (a', STac stac) = handle_leaf "next  " th sr E a v t;
   7.192 +"~~~~~ fun stac2tac_, args:"; val (pt, thy, (Const("Script.Check'_elementwise",_) $ _ $ 
   7.193 +		(set as Const ("Set.Collect",_) $ Abs (_,_,pred)))) = (pt, (assoc_thy th), stac);
   7.194 +(*2011 changed ^^^^^   *)
   7.195 +val (p,_,f,nxt,_,pt) = me nxt p'''' [] pt''''; (*WAS nxt = ("Empty_Tac", Empty_Tac)*)
   7.196 +if nxt = ("Check_elementwise", Check_elementwise "Assumptions") then ()
   7.197 +else error "Check_elementwise changed; after switch sub-->root-method"
   7.198 +*}
   7.199  end
   7.200  
   7.201  (*=== inhibit exn ?=============================================================