src/Tools/isac/Interpret/appl.sml
author Walther Neuper <wneuper@ist.tugraz.at>
Mon, 19 Dec 2016 10:37:44 +0100
changeset 59271 7a02202e4577
parent 59269 1da53d1540fe
child 59272 1d3ef477d9c8
permissions -rw-r--r--
renamed structure to Generate : GENERATE_CALC_TREE

Note: only few funs shall go to structure Ctree
     1 (* use"ME/appl.sml";
     2    use"appl.sml";
     3 
     4 12345678901234567890123456789012345678901234567890123456789012345678901234567890
     5         10        20        30        40        50        60        70        80
     6 *)
     7 val e_cterm' = empty_cterm';
     8 
     9 
    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, ...}) =
    13     (rew_ord',erls,ca)
    14   | rew_info (Rrls {erls,rew_ord=(rew_ord',_),calc=ca, ...}) =
    15     (rew_ord',erls, ca)
    16   | rew_info rls = error ("rew_info called with '"^rls2str rls^"'");
    17 
    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 = 
    20   let 
    21     val (pbl, p', rls') = par_pbl_det pt p
    22   in 
    23     if pbl
    24     then 
    25       let 
    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
    29      else 
    30       let
    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
    34   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 = 
    37   let
    38     val (pbl,p',rls') = par_pbl_det pt p
    39   in
    40     if pbl
    41     then
    42       let
    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)
    46 	    in
    47 	      case opt of
    48 	        SOME isa_fn => ("OK",thy',isa_fn)
    49 	      | NONE => ("applicable_in Calculate: unknown '" ^ scrop ^ "'", "", ("", e_evalfn))
    50 	    end
    51     else 
    52 		  let
    53 		    val thy' = get_obj g_domID pt (par_pblobj pt p);
    54 		    val (_,_,(*_,*)scr_isa_fns) = rew_info rls'(*rls*)
    55 		  in
    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))
    59 		  end
    60   end;
    61 
    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
    65 *)
    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*)
    70 
    71 fun mk_and [] = @{term True}
    72   | mk_and (t::[]) = t
    73   | mk_and (t::ts) = 
    74     let fun mk t' (t::[]) = op_and $ t' $ t
    75 	  | mk t' (t::ts) = mk (op_and $ t' $ t) ts
    76     in mk t ts end;
    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*)
    81 
    82 
    83 
    84 
    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, [])
    87 
    88   | mk_set thy pt p (Const ("Tools.UniversalList",_)) pred =
    89     (e_term, if pred <> Const ("Script.Assumptions",bool)
    90 	     then [pred] 
    91 	     else get_assumptions_ pt (p,Res))
    92 
    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;
    96    *)
    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)
   100 		 then [pred] 
   101 	       else get_assumptions_ pt (p,Res)
   102   in (bdv, pred) end
   103 
   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])];
   111 > val p = [];
   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) & ...
   115 
   116  val consts = str2term "UniversalList";
   117  val pred = str2term "Assumptions";
   118 
   119 *)
   120 
   121 
   122 
   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);
   126    *)
   127 fun check_elementwise thy erls all_results (bdv, asm) =
   128     let   (*bdv extracted from ~~~~~~~~~~~ in mk_set already*)
   129 	fun check sub =
   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) => ([],[])
   134 	    end;
   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;
   143 (* 20.5.03
   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)";
   147 > val erls = e_rls;
   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*)
   156 
   157 
   158 
   159 (*before 5.03-----
   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'
   164 
   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'
   169 
   170 
   171 > val const  = (Thm.term_of o the o (parse thy)) "(#3::real)";
   172 > val pred' = subst_atomic [(bdv,const)] pred;
   173 
   174 
   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
   182 
   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
   190 
   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*)
   198 
   199 
   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*)
   210 
   211 
   212 
   213 
   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_'.
   218 .*)
   219 fun applicable_in (_:pos') _ (Init_Proof (ct', spec)) = Chead.Appl (Init_Proof' (ct', spec))
   220 
   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_)))
   224       else 
   225         let 
   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
   230 
   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_)))
   234       else 
   235         let 
   236           val (PblObj {origin = (oris, (dI',_,_),_), ...}) = get_obj I pt p;
   237           val opt = Specify.refine_ori oris pI;
   238         in case opt of
   239 	           SOME pblID => 
   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")
   243         end
   244 
   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_)))
   249   else
   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;
   254     in case rfopt of
   255 	   NONE => Chead.Notappl ((tac2str (Refine_Problem pI))^" not applicable")
   256 	 | SOME (rf as (pI',_)) =>
   257 	   if pI' = pI
   258 	   then Chead.Notappl ((tac2str (Refine_Problem pI))^" not applicable")
   259 	   else Chead.Appl (Refine_Problem' rf)
   260     end
   261 
   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*)
   270 
   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')
   276 
   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*)]))
   282 
   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')
   288 
   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*)]))
   294 
   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')
   300 
   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;
   308    *)
   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_)))
   313   else
   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; 
   323    *)
   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*)]))
   330 
   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_)))
   334       else
   335         let
   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_
   339           val ctxt = 
   340             if is_e_ctxt ctxt
   341             then assoc_thy dI |> Proof_Context.init_global |> insert_assumptions pres
   342             else ctxt
   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
   348 
   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*)])))
   353 
   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')
   357 
   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_)))
   361     else
   362       let 
   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_));
   371       in 
   372         let
   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
   376              SOME (f',asm) =>
   377                Chead.Appl (Rewrite_Inst' (thy', ro', erls, false, subst, thm'', f, (f', asm)))
   378            | NONE => Chead.Notappl ((fst thm'')^" not applicable")
   379         end
   380         handle _ => Chead.Notappl ("syntax error in "^(subs2str subs))
   381       end
   382 
   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_)))
   386   else
   387   let val (msg,thy',ro,rls',(*put_asm*)_)= from_pblobj_or_detail_thm thm'' p pt;
   388     val thy = assoc_thy thy';
   389     val f = case p_ of
   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 "^
   393 				(pos'2str (p,p_)));
   394   in if msg = "OK" 
   395      then
   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
   400   end
   401 
   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_)))
   405   else
   406   let 
   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 "^
   416 				(pos'2str (p,p_)));
   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
   421 
   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_)))
   425   else
   426   let 
   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 "^
   434 					 (pos'2str (p,p_)));
   435   in 
   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
   443 
   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_)))
   447   else
   448   let 
   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 "^
   457 				(pos'2str (p,p_)));
   458   in 
   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
   466 
   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_)))
   470   else
   471   let 
   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 "^
   478 				(pos'2str (p,p_)));
   479   in case rewrite_set_ (assoc_thy thy') false (assoc_rls rls) f of
   480        SOME (f',asm) => 
   481 	((*tracing("#.# applicable_in Rewrite_Set,2f'= "^f');*)
   482 	 Chead.Appl (Rewrite_Set' (thy',(*put_asm*)false,assoc_rls rls, f, (f', asm)))
   483 	 )
   484      | NONE => Chead.Notappl (rls^" not applicable") end
   485 
   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_)))
   489     else
   490 	let val pp = par_pblobj pt p 
   491 	    val thy' = (get_obj g_domID pt pp):theory'
   492 	    val f = case p_ of
   493 			Frm => get_obj g_form pt p
   494 		      | Res => (fst o (get_obj g_result pt)) p
   495 		      | _ => error ("applicable_in: call by "^
   496 					  (pos'2str (p,p_)));
   497 	in case rewrite_set_ (assoc_thy thy') false (assoc_rls rls) f of
   498 	       SOME (f',asm) => 
   499 	       Chead.Appl (Detail_Set' (thy',false,assoc_rls rls, f, (f',asm)))
   500 	     | NONE => Chead.Notappl (rls^" not applicable") end
   501 
   502 
   503   | applicable_in p pt (End_Ruleset) = 
   504   error ("applicable_in: not impl. for "^
   505 	       (tac2str End_Ruleset))
   506 
   507 (* val ((p,p_), pt, (m as Calculate op_)) = (p, pt, m);
   508    *)
   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_)))
   512   else
   513   let 
   514     val (msg,thy',isa_fn) = from_pblobj_or_detail_calc op_ p pt;
   515     val f = case p_ of
   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
   524   end
   525 
   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_)))
   533       else 
   534         let
   535           val pp = par_pblobj pt p
   536           val thy = assoc_thy (get_obj g_domID pt pp)
   537           val f = case p_ of
   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'
   544 		    in
   545 		      if foldl and_ (true, map contains_Var subte)
   546 		      (*1*)
   547 		      then
   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'))
   551 		        end
   552 		        (*2*)
   553 		      else 
   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")
   557 		    end
   558 
   559   | applicable_in p pt (Apply_Assumption cts') = 
   560       (error ("applicable_in: not impl. for " ^ (tac2str (Apply_Assumption cts'))))
   561   
   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_))
   566       else
   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'))
   571         end
   572 
   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)))
   577 
   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
   582 	        SOME is => 
   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))
   589 
   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)
   602 
   603   | applicable_in (p,p_) pt (Begin_Trans) =
   604     let
   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 "^
   610 				(pos'2str (p,p_)));
   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
   615 
   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);
   619     in if p_ = Res 
   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*)
   623     end
   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))
   632 
   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_)))
   636     else
   637       let 
   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;
   646       in case f of
   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")
   654       end
   655 
   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_)))
   659   else
   660   let 
   661     val pp = par_pblobj pt p; 
   662     val thy' = (get_obj g_domID pt pp):theory';
   663     val thy = assoc_thy thy';
   664     val f = case p_ of
   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))
   670   end
   671 
   672   | applicable_in p pt (Collect_Trues) = 
   673   error ("applicable_in: not impl. for "^
   674 	       (tac2str (Collect_Trues)))
   675 
   676   | applicable_in p pt (Empty_Tac) = 
   677   Chead.Notappl "Empty_Tac is not applicable"
   678 
   679   | applicable_in (p,p_) pt (Tac id) =
   680   let 
   681     val pp = par_pblobj pt p; 
   682     val thy' = (get_obj g_domID pt pp):theory';
   683     val thy = assoc_thy thy';
   684     val f = case p_ of
   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;
   688   in case id of
   689       "subproblem_equation_dummy" =>
   690 	  if is_expliceq f
   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= "
   696 				 ^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
   706 
   707   | applicable_in p pt End_Proof' = Chead.Appl End_Proof''
   708 
   709   | applicable_in _ _ m = 
   710   error ("applicable_in called for "^(tac2str m));
   711 
   712 (*WN060614 unused*)
   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"^
   717 				  (tac2str m));
   718