src/Tools/isac/Specify/appl.sml
author Walther Neuper <walther.neuper@jku.at>
Tue, 17 Dec 2019 16:31:46 +0100
changeset 59737 5e2834f8a655
parent 59735 fdb080fe34a4
child 59743 e6d97ceba3fc
permissions -rw-r--r--
lucin: shift Istate into Interpret/ from MathEngBasic

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