src/Tools/isac/Interpret/appl.sml
author Walther Neuper <wneuper@ist.tugraz.at>
Wed, 21 Dec 2016 08:57:47 +0100
changeset 59272 1d3ef477d9c8
parent 59271 7a02202e4577
child 59276 56dc790071cb
permissions -rw-r--r--
added structure Applicable INTERMEDIATELY

Note: introduction of structure Ctree : CALC_TREE is in the works,
but this is persuasive such, that "open Ctree" seems useful,
but the latter seems to require a structure to localise it.
neuper@37906
     1
(* use"ME/appl.sml";
neuper@37906
     2
   use"appl.sml";
neuper@37936
     3
neuper@37936
     4
12345678901234567890123456789012345678901234567890123456789012345678901234567890
neuper@37936
     5
        10        20        30        40        50        60        70        80
neuper@37936
     6
*)
wneuper@59272
     7
wneuper@59272
     8
structure Applicable = (* intermediately to avoid too many "Ctree." *)
wneuper@59272
     9
struct
wneuper@59272
    10
(*open Ctree*)
wneuper@59272
    11
neuper@37906
    12
val e_cterm' = empty_cterm';
neuper@37906
    13
neuper@37906
    14
neuper@37906
    15
fun rew_info (Rls {erls,rew_ord=(rew_ord',_),calc=ca, ...}) =
neuper@37906
    16
    (rew_ord':rew_ord',erls,ca)
neuper@37906
    17
  | rew_info (Seq {erls,rew_ord=(rew_ord',_),calc=ca, ...}) =
neuper@37906
    18
    (rew_ord',erls,ca)
neuper@37906
    19
  | rew_info (Rrls {erls,rew_ord=(rew_ord',_),calc=ca, ...}) =
neuper@37906
    20
    (rew_ord',erls, ca)
neuper@38031
    21
  | rew_info rls = error ("rew_info called with '"^rls2str rls^"'");
neuper@37906
    22
neuper@37906
    23
(*FIXME.3.4.03:re-organize from_pblobj_or_detail_thm after rls' --> rls*)
neuper@37906
    24
fun from_pblobj_or_detail_thm thm' p pt = 
neuper@52155
    25
  let 
neuper@52155
    26
    val (pbl, p', rls') = par_pbl_det pt p
neuper@52155
    27
  in 
neuper@52155
    28
    if pbl
neuper@52155
    29
    then 
neuper@52155
    30
      let 
neuper@52155
    31
        val thy' = get_obj g_domID pt p'
wneuper@59269
    32
        val {rew_ord', erls, ...} = Specify.get_met (get_obj g_metID pt p')              
neuper@52155
    33
	    in ("OK", thy', rew_ord', erls, false) end
neuper@52155
    34
     else 
neuper@52155
    35
      let
neuper@52155
    36
        val thy' = get_obj g_domID pt (par_pblobj pt p)
neuper@52155
    37
		    val (rew_ord', erls, _) = rew_info rls'
neuper@52155
    38
		  in ("OK",thy',rew_ord',erls,false) end
neuper@52155
    39
  end;
neuper@37906
    40
(*FIXME.3.4.03:re-organize from_pblobj_or_detail_calc after rls' --> rls*)
neuper@37906
    41
fun from_pblobj_or_detail_calc scrop p pt = 
neuper@52155
    42
  let
neuper@52155
    43
    val (pbl,p',rls') = par_pbl_det pt p
neuper@52155
    44
  in
neuper@52155
    45
    if pbl
neuper@52155
    46
    then
neuper@52155
    47
      let
neuper@52155
    48
        val thy' = get_obj g_domID pt p'
wneuper@59269
    49
        val {calc = scr_isa_fns,...} = Specify.get_met (get_obj g_metID pt p')
neuper@52155
    50
        val opt = assoc (scr_isa_fns, scrop)
neuper@52155
    51
	    in
neuper@52155
    52
	      case opt of
neuper@52155
    53
	        SOME isa_fn => ("OK",thy',isa_fn)
neuper@52155
    54
	      | NONE => ("applicable_in Calculate: unknown '" ^ scrop ^ "'", "", ("", e_evalfn))
neuper@52155
    55
	    end
neuper@52155
    56
    else 
neuper@52155
    57
		  let
neuper@52155
    58
		    val thy' = get_obj g_domID pt (par_pblobj pt p);
neuper@37906
    59
		    val (_,_,(*_,*)scr_isa_fns) = rew_info rls'(*rls*)
neuper@52155
    60
		  in
neuper@52155
    61
		    case assoc (scr_isa_fns, scrop) of
neuper@52155
    62
		      SOME isa_fn => ("OK",thy',isa_fn)
neuper@52155
    63
		    | NONE => ("applicable_in Calculate: unknown '" ^ scrop ^ "'", "", ("", e_evalfn))
neuper@52155
    64
		  end
neuper@52155
    65
  end;
neuper@37906
    66
neuper@37906
    67
val op_and = Const ("op &", [bool, bool] ---> bool);
wneuper@59184
    68
(*> (Thm.global_cterm_of thy) (op_and $ Free("a",bool) $ Free("b",bool));
neuper@37906
    69
val it = "a & b" : cterm
neuper@37906
    70
*)
neuper@37906
    71
fun mk_and a b = op_and $ a $ b;
wneuper@59184
    72
(*> (Thm.global_cterm_of thy) 
neuper@37906
    73
     (mk_and (Free("a",bool)) (Free("b",bool)));
neuper@37906
    74
val it = "a & b" : cterm*)
neuper@37906
    75
neuper@48760
    76
fun mk_and [] = @{term True}
neuper@37906
    77
  | mk_and (t::[]) = t
neuper@37906
    78
  | mk_and (t::ts) = 
neuper@37906
    79
    let fun mk t' (t::[]) = op_and $ t' $ t
neuper@37906
    80
	  | mk t' (t::ts) = mk (op_and $ t' $ t) ts
neuper@37906
    81
    in mk t ts end;
wneuper@59186
    82
(*> val pred = map (Thm.term_of o the o (parse thy)) 
neuper@37906
    83
             ["#0 <= #9 + #4 * x","#0 <= sqrt x + sqrt (#-3 + x)"];
wneuper@59184
    84
> (Thm.global_cterm_of thy) (mk_and pred);
neuper@37906
    85
val it = "#0 <= #9 + #4 * x & #0 <= sqrt x + sqrt (#-3 + x)" : cterm*)
neuper@37906
    86
neuper@37906
    87
neuper@37906
    88
neuper@37906
    89
neuper@37906
    90
(*for Check_elementwise in applicable_in: [x=1,..] Assumptions -> (x,0<=x&..)*)
neuper@37906
    91
fun mk_set thy pt p (Const ("List.list.Nil",_)) pred = (e_term, [])
neuper@37906
    92
neuper@37906
    93
  | mk_set thy pt p (Const ("Tools.UniversalList",_)) pred =
neuper@37906
    94
    (e_term, if pred <> Const ("Script.Assumptions",bool)
neuper@37906
    95
	     then [pred] 
e0726734@41957
    96
	     else get_assumptions_ pt (p,Res))
neuper@37906
    97
wneuper@59186
    98
(* val pred = (Thm.term_of o the o (parse thy)) pred;
neuper@37906
    99
   val consts as Const ("List.list.Cons",_) $ eq $ _ = ft;
neuper@37906
   100
   mk_set thy pt p consts pred;
neuper@37906
   101
   *)
neuper@37906
   102
  | mk_set thy pt p (consts as Const ("List.list.Cons",_) $ eq $ _) pred =
neuper@37906
   103
  let val (bdv,_) = HOLogic.dest_eq eq;
neuper@37906
   104
    val pred = if pred <> Const ("Script.Assumptions",bool)
neuper@37906
   105
		 then [pred] 
e0726734@41957
   106
	       else get_assumptions_ pt (p,Res)
neuper@37906
   107
  in (bdv, pred) end
neuper@37906
   108
neuper@37906
   109
  | mk_set thy _ _ l _ = 
neuper@38053
   110
    error ("check_elementwise: no set " ^ term2str l);
neuper@37906
   111
(*> val consts = str2term "[x=#4]";
neuper@37906
   112
> val pred = str2term "Assumptions";
neuper@37906
   113
> val pt = union_asm pt p 
neuper@37906
   114
   [("#0 <= sqrt x + sqrt (#5 + x)",[11]),("#0 <= #9 + #4 * x",[22]),
neuper@37906
   115
   ("#0 <= x ^^^ #2 + #5 * x",[33]),("#0 <= #2 + x",[44])];
neuper@37906
   116
> val p = [];
neuper@37906
   117
> val (sss,ttt) = mk_set thy pt p consts pred;
neuper@38053
   118
> (term2str sss, term2str ttt);
neuper@37906
   119
val it = ("x","((#0 <= sqrt x + sqrt (#5 + x) & #0 <= #9 + #4 * x) & ...
neuper@37906
   120
neuper@37906
   121
 val consts = str2term "UniversalList";
neuper@37906
   122
 val pred = str2term "Assumptions";
neuper@37906
   123
neuper@37906
   124
*)
neuper@37906
   125
neuper@37906
   126
neuper@37906
   127
neuper@37906
   128
(*check a list (/set) of constants [c_1,..,c_n] for c_i:set (: in)*)
neuper@37906
   129
(* val (erls,consts,(bdv,pred)) = (erl,ft,vp);
neuper@37906
   130
   val (consts,(bdv,pred)) = (ft,vp);
neuper@37906
   131
   *)
neuper@37906
   132
fun check_elementwise thy erls all_results (bdv, asm) =
neuper@37906
   133
    let   (*bdv extracted from ~~~~~~~~~~~ in mk_set already*)
neuper@37906
   134
	fun check sub =
neuper@37906
   135
	    let val inst_ = map (subst_atomic [sub]) asm
neuper@37906
   136
	    in case eval__true thy 1 inst_ [] erls of
neuper@37906
   137
		   (asm', true) => ([HOLogic.mk_eq sub], asm')
neuper@37906
   138
		 | (_, false) => ([],[])
neuper@37906
   139
	    end;
neuper@38015
   140
      (*val _= tracing("### check_elementwise: res= "^(term2str all_results)^
neuper@37906
   141
		       ", bdv= "^(term2str bdv)^", asm= "^(terms2str asm));*)
neuper@37906
   142
	val c' = isalist2list all_results
neuper@37906
   143
	val c'' = map (snd o HOLogic.dest_eq) c' (*assumes [x=1,x=2,..]*)
neuper@37906
   144
	val subs = map (pair bdv) c''
neuper@37906
   145
    in if asm = [] then (all_results, [])
neuper@37906
   146
       else ((apfst ((list2isalist bool) o flat)) o 
neuper@37906
   147
	     (apsnd flat) o split_list o (map check)) subs end;
neuper@37906
   148
(* 20.5.03
neuper@37906
   149
> val all_results = str2term "[x=a+b,x=b,x=3]";
neuper@37906
   150
> val bdv = str2term "x";
neuper@37906
   151
> val asm = str2term "(x ~= a) & (x ~= b)";
neuper@37906
   152
> val erls = e_rls;
neuper@37906
   153
> val (t, ts) = check_elementwise thy erls all_results (bdv, asm);
neuper@38015
   154
> term2str t; tracing(terms2str ts);
neuper@37906
   155
val it = "[x = a + b, x = b, x = c]" : string
neuper@37906
   156
["a + b ~= a & a + b ~= b","b ~= a & b ~= b","c ~= a & c ~= b"]
neuper@37906
   157
... with appropriate erls this should be:
neuper@37906
   158
val it = "[x = a + b,       x = c]" : string
neuper@37906
   159
["b ~= 0 & a ~= 0",         "3 ~= a & 3 ~= b"]
neuper@37906
   160
                    ////// because b ~= b False*)
neuper@37906
   161
neuper@37906
   162
neuper@37906
   163
neuper@37906
   164
(*before 5.03-----
neuper@37906
   165
> val ct = "((#0 <= #18 & #0 <= sqrt (#5 + #3) + sqrt (#5 - #3)) &\
neuper@37906
   166
	   \ #0 <= #25 + #-1 * #3 ^^^ #2) & #0 <= #4";
neuper@38050
   167
> val SOME(ct',_) = rewrite_set "Isac" false "eval_rls" ct;
neuper@41928
   168
val ct' = "HOL.True" : cterm'
neuper@37906
   169
neuper@37906
   170
> val ct = "((#0 <= #18 & #0 <= sqrt (#5 + #-3) + sqrt (#5 - #-3)) &\
neuper@37906
   171
	   \ #0 <= #25 + #-1 * #-3 ^^^ #2) & #0 <= #4";
neuper@38050
   172
> val SOME(ct',_) = rewrite_set "Isac"  false "eval_rls" ct;
neuper@41928
   173
val ct' = "HOL.True" : cterm'
neuper@37906
   174
neuper@37906
   175
wneuper@59186
   176
> val const  = (Thm.term_of o the o (parse thy)) "(#3::real)";
neuper@37906
   177
> val pred' = subst_atomic [(bdv,const)] pred;
neuper@37906
   178
neuper@37906
   179
wneuper@59186
   180
> val consts = (Thm.term_of o the o (parse thy)) "[x = #-3, x = #3]";
wneuper@59186
   181
> val bdv    = (Thm.term_of o the o (parse thy)) "(x::real)";
wneuper@59186
   182
> val pred   = (Thm.term_of o the o (parse thy)) 
neuper@37906
   183
  "((#0 <= #18 & #0 <= sqrt (#5 + x) + sqrt (#5 - x)) & #0 <= #25 + #-1 * x ^^^ #2) & #0 <= #4";
neuper@37906
   184
> val ttt = check_elementwise thy consts (bdv, pred);
wneuper@59184
   185
> (Thm.global_cterm_of thy) ttt;
neuper@37906
   186
val it = "[x = #-3, x = #3]" : cterm
neuper@37906
   187
wneuper@59186
   188
> val consts = (Thm.term_of o the o (parse thy)) "[x = #4]";
wneuper@59186
   189
> val bdv    = (Thm.term_of o the o (parse thy)) "(x::real)";
wneuper@59186
   190
> val pred   = (Thm.term_of o the o (parse thy)) 
neuper@37906
   191
 "#0 <= sqrt x + sqrt (#5 + x) & #0 <= #9 + #4 * x & #0 <= x ^^^ #2 + #5 * x & #0 <= #2 + x";
neuper@37906
   192
> val ttt = check_elementwise thy consts (bdv,pred);
wneuper@59184
   193
> (Thm.global_cterm_of thy) ttt;
neuper@37906
   194
val it = "[x = #4]" : cterm
neuper@37906
   195
wneuper@59186
   196
> val consts = (Thm.term_of o the o (parse thy)) "[x = #-12 // #5]";
wneuper@59186
   197
> val bdv    = (Thm.term_of o the o (parse thy)) "(x::real)";
wneuper@59186
   198
> val pred   = (Thm.term_of o the o (parse thy))
neuper@37906
   199
 " #0 <= sqrt x + sqrt (#-3 + x) & #0 <= #9 + #4 * x & #0 <= x ^^^ #2 + #-3 * x & #0 <= #6 + x";
neuper@37906
   200
> val ttt = check_elementwise thy consts (bdv,pred);
wneuper@59184
   201
> (Thm.global_cterm_of thy) ttt;
neuper@37906
   202
val it = "[]" : cterm*)
neuper@37906
   203
neuper@37906
   204
neuper@37906
   205
(* 14.1.01: for Tac-dummies in root-equ only: skip str until "("*)
neuper@37906
   206
fun split_dummy str = 
neuper@37906
   207
let fun scan s' [] = (implode s', "")
neuper@37906
   208
      | scan s' (s::ss) = if s=" " then (implode s', implode  ss)
neuper@37906
   209
			  else scan (s'@[s]) ss;
neuper@40836
   210
in ((scan []) o Symbol.explode) str end;
neuper@37906
   211
(* split_dummy "subproblem_equation_dummy (x=-#5//#12)";
neuper@37906
   212
val it = ("subproblem_equation_dummy","(x=-#5//#12)") : string * string
neuper@37906
   213
> split_dummy "x=-#5//#12";
neuper@37906
   214
val it = ("x=-#5//#12","") : string * string*)
neuper@37906
   215
neuper@37906
   216
neuper@37906
   217
neuper@37906
   218
neuper@37906
   219
(*.applicability of a tacic wrt. a calc-state (ptree,pos').
neuper@41980
   220
   additionally used by next_tac in the script-interpreter for script-tacs.
neuper@37906
   221
   tests for applicability are so expensive, that results (rewrites!)
neuper@37906
   222
   are kept in the return-value of 'type tac_'.
neuper@37906
   223
.*)
wneuper@59265
   224
fun applicable_in (_:pos') _ (Init_Proof (ct', spec)) = Chead.Appl (Init_Proof' (ct', spec))
neuper@37906
   225
neuper@37906
   226
  | applicable_in (p,p_) pt Model_Problem = 
neuper@41975
   227
      if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
wneuper@59265
   228
      then Chead.Notappl ((tac2str Model_Problem) ^ " not for pos " ^ (pos'2str (p,p_)))
neuper@41975
   229
      else 
neuper@41975
   230
        let 
neuper@41975
   231
          val (PblObj{origin=(_,(_,pI',_),_),...}) = get_obj I pt p
wneuper@59269
   232
	        val {ppc,...} = Specify.get_pbt pI'
wneuper@59271
   233
	        val pbl = Generate.init_pbl ppc
wneuper@59265
   234
        in Chead.Appl (Model_Problem' (pI', pbl, [])) end
neuper@41975
   235
neuper@37906
   236
  | applicable_in (p,p_) pt (Refine_Tacitly pI) = 
neuper@41975
   237
      if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
wneuper@59265
   238
      then Chead.Notappl ((tac2str (Refine_Tacitly pI)) ^ " not for pos " ^ (pos'2str (p,p_)))
neuper@41975
   239
      else 
neuper@41975
   240
        let 
neuper@41975
   241
          val (PblObj {origin = (oris, (dI',_,_),_), ...}) = get_obj I pt p;
wneuper@59269
   242
          val opt = Specify.refine_ori oris pI;
neuper@41975
   243
        in case opt of
neuper@41975
   244
	           SOME pblID => 
wneuper@59265
   245
	             Chead.Appl (Refine_Tacitly' (pI, pblID, 
neuper@41975
   246
				         e_domID, e_metID, [](*filled in specify*)))
wneuper@59265
   247
	         | NONE => Chead.Notappl ((tac2str (Refine_Tacitly pI)) ^ " not applicable")
neuper@41975
   248
        end
neuper@41975
   249
neuper@37906
   250
  | applicable_in (p,p_) pt (Refine_Problem pI) = 
neuper@37906
   251
  if not (is_pblobj (get_obj I pt p)) orelse p_ = Res                  
wneuper@59265
   252
    then Chead.Notappl ((tac2str (Refine_Problem pI))^
neuper@37906
   253
	   " not for pos "^(pos'2str (p,p_)))
neuper@37906
   254
  else
neuper@37906
   255
    let val (PblObj {origin=(_,(dI,_,_),_),spec=(dI',_,_),
neuper@37906
   256
		     probl=itms, ...}) = get_obj I pt p;
neuper@37906
   257
	val thy = if dI' = e_domID then dI else dI';
wneuper@59269
   258
	val rfopt = Specify.refine_pbl (assoc_thy thy) pI itms;
neuper@37906
   259
    in case rfopt of
wneuper@59265
   260
	   NONE => Chead.Notappl ((tac2str (Refine_Problem pI))^" not applicable")
neuper@37926
   261
	 | SOME (rf as (pI',_)) =>
neuper@37906
   262
	   if pI' = pI
wneuper@59265
   263
	   then Chead.Notappl ((tac2str (Refine_Problem pI))^" not applicable")
wneuper@59265
   264
	   else Chead.Appl (Refine_Problem' rf)
neuper@37906
   265
    end
neuper@37906
   266
neuper@37906
   267
  (*the specify-tacs have cterm' instead term: 
neuper@37906
   268
   parse+error here!!!: see appl_add*)  
neuper@37906
   269
  | applicable_in (p,p_) pt (Add_Given ct') = 
neuper@37906
   270
  if not (is_pblobj (get_obj I pt p)) orelse p_ = Res                  
wneuper@59265
   271
    then Chead.Notappl ((tac2str (Add_Given ct'))^
neuper@37906
   272
	   " not for pos "^(pos'2str (p,p_)))
wneuper@59265
   273
  else Chead.Appl (Add_Given' (ct', [(*filled in specify_additem*)]))
neuper@37906
   274
  (*Add_.. should reject (dsc //) (see fmz=[] in sqrt*)
neuper@37906
   275
neuper@37906
   276
  | applicable_in (p,p_) pt (Del_Given ct') =
neuper@37906
   277
  if not (is_pblobj (get_obj I pt p)) orelse p_ = Res                  
wneuper@59265
   278
    then Chead.Notappl ((tac2str (Del_Given ct'))^
neuper@37906
   279
	   " not for pos "^(pos'2str (p,p_)))
wneuper@59265
   280
  else Chead.Appl (Del_Given' ct')
neuper@37906
   281
neuper@37906
   282
  | applicable_in (p,p_) pt (Add_Find ct') =                   
neuper@37906
   283
  if not (is_pblobj (get_obj I pt p)) orelse p_ = Res                  
wneuper@59265
   284
    then Chead.Notappl ((tac2str (Add_Find ct'))^
neuper@37906
   285
	   " not for pos "^(pos'2str (p,p_)))
wneuper@59265
   286
  else Chead.Appl (Add_Find' (ct', [(*filled in specify_additem*)]))
neuper@37906
   287
neuper@37906
   288
  | applicable_in (p,p_) pt (Del_Find ct') =
neuper@37906
   289
  if not (is_pblobj (get_obj I pt p)) orelse p_ = Res                  
wneuper@59265
   290
    then Chead.Notappl ((tac2str (Del_Find ct'))^
neuper@37906
   291
	   " not for pos "^(pos'2str (p,p_)))
wneuper@59265
   292
  else Chead.Appl (Del_Find' ct')
neuper@37906
   293
neuper@37906
   294
  | applicable_in (p,p_) pt (Add_Relation ct') =               
neuper@37906
   295
  if not (is_pblobj (get_obj I pt p)) orelse p_ = Res                  
wneuper@59265
   296
    then Chead.Notappl ((tac2str (Add_Relation ct'))^
neuper@37906
   297
	   " not for pos "^(pos'2str (p,p_)))
wneuper@59265
   298
  else Chead.Appl (Add_Relation' (ct', [(*filled in specify_additem*)]))
neuper@37906
   299
neuper@37906
   300
  | applicable_in (p,p_) pt (Del_Relation ct') =
neuper@37906
   301
  if not (is_pblobj (get_obj I pt p)) orelse p_ = Res                  
wneuper@59265
   302
    then Chead.Notappl ((tac2str (Del_Relation ct'))^
neuper@37906
   303
	   " not for pos "^(pos'2str (p,p_)))
wneuper@59265
   304
  else Chead.Appl (Del_Relation' ct')
neuper@37906
   305
neuper@37906
   306
  | applicable_in (p,p_) pt (Specify_Theory dI) =              
neuper@37906
   307
  if not (is_pblobj (get_obj I pt p)) orelse p_ = Res                  
wneuper@59265
   308
    then Chead.Notappl ((tac2str (Specify_Theory dI))^
neuper@37906
   309
	   " not for pos "^(pos'2str (p,p_)))
wneuper@59265
   310
  else Chead.Appl (Specify_Theory' dI)
neuper@37906
   311
(* val (p,p_) = p; val Specify_Problem pID = m;
neuper@37906
   312
   val Specify_Problem pID = m;
neuper@37906
   313
   *)
neuper@37906
   314
  | applicable_in (p,p_) pt (Specify_Problem pID) = 
neuper@37906
   315
  if not (is_pblobj (get_obj I pt p)) orelse p_ = Res                  
wneuper@59265
   316
    then Chead.Notappl ((tac2str (Specify_Problem pID))^
neuper@37906
   317
	   " not for pos "^(pos'2str (p,p_)))
neuper@37906
   318
  else
neuper@37906
   319
    let val (PblObj {origin=(oris,(dI,pI,_),_),spec=(dI',pI',_),
neuper@37906
   320
		     probl=itms, ...}) = get_obj I pt p;
neuper@37906
   321
	val thy = assoc_thy (if dI' = e_domID then dI else dI');
wneuper@59269
   322
        val {ppc,where_,prls,...} = Specify.get_pbt pID;
neuper@37906
   323
	val pbl = if pI'=e_pblID andalso pI=e_pblID
wneuper@59271
   324
		  then (false, (Generate.init_pbl ppc, []))
wneuper@59269
   325
		  else Specify.match_itms_oris thy itms (ppc,where_,prls) oris;
wneuper@59265
   326
    in Chead.Appl (Specify_Problem' (pID, pbl)) end
neuper@37906
   327
(* val Specify_Method mID = nxt; val (p,p_) = p; 
neuper@37906
   328
   *)
neuper@37906
   329
  | applicable_in (p,p_) pt (Specify_Method mID) =              
neuper@37906
   330
  if not (is_pblobj (get_obj I pt p)) orelse p_ = Res               
wneuper@59265
   331
    then Chead.Notappl ((tac2str (Specify_Method mID))^
neuper@37906
   332
	   " not for pos "^(pos'2str (p,p_)))
wneuper@59265
   333
  else Chead.Appl (Specify_Method' (mID,[(*filled in specify*)],
neuper@37906
   334
			      [(*filled in specify*)]))
neuper@37906
   335
neuper@37906
   336
  | applicable_in (p,p_) pt (Apply_Method mI) =                
neuper@41992
   337
      if not (is_pblobj (get_obj I pt p)) orelse p_ = Res                  
wneuper@59265
   338
      then Chead.Notappl ((tac2str (Apply_Method mI)) ^ " not for pos " ^ (pos'2str (p,p_)))
neuper@41992
   339
      else
neuper@41992
   340
        let
neuper@41992
   341
          val (PblObj{origin = (_, (dI, pI, _), _), probl, ctxt, ...}) = get_obj I pt p;
wneuper@59269
   342
          val {where_, ...} = Specify.get_pbt pI
neuper@41992
   343
          val pres = map (mk_env probl |> subst_atomic) where_
neuper@41992
   344
          val ctxt = 
neuper@41992
   345
            if is_e_ctxt ctxt
neuper@48761
   346
            then assoc_thy dI |> Proof_Context.init_global |> insert_assumptions pres
neuper@41992
   347
            else ctxt
neuper@42018
   348
         (*TODO.WN110416 here do evalprecond according to fun check_preconds'
wneuper@59265
   349
         and then decide on Chead.Notappl/Appl accordingly once more.
neuper@42018
   350
         Implement after all tests are running, since this changes
neuper@42018
   351
         overall system behavior*)
wneuper@59265
   352
      in Chead.Appl (Apply_Method' (mI, NONE, e_istate (*filled in solve*), ctxt)) end
neuper@37906
   353
neuper@37906
   354
  | applicable_in (p,p_) pt (Check_Postcond pI) =
neuper@42018
   355
      if member op = [Pbl,Met] p_                  
wneuper@59265
   356
      then Chead.Notappl ((tac2str (Check_Postcond pI)) ^ " not for pos "^(pos'2str (p,p_)))
wneuper@59265
   357
      else Chead.Appl (Check_Postcond' (pI, (e_term, [(*fun solve assignes the returnvalue of scr*)])))
neuper@37906
   358
neuper@37906
   359
  (*these are always applicable*)
wneuper@59265
   360
  | applicable_in (p,p_) _ (Take str) = Chead.Appl (Take' (str2term str))
wneuper@59265
   361
  | applicable_in (p,p_) _ (Free_Solve) = Chead.Appl (Free_Solve')
neuper@37906
   362
wneuper@59250
   363
  | applicable_in (p, p_) pt (m as Rewrite_Inst (subs, thm'')) = 
neuper@42394
   364
    if member op = [Pbl, Met] p_ 
wneuper@59265
   365
    then Chead.Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
neuper@42394
   366
    else
neuper@42394
   367
      let 
neuper@42394
   368
        val pp = par_pblobj pt p;
neuper@42394
   369
        val thy' = (get_obj g_domID pt pp): theory';
neuper@42394
   370
        val thy = assoc_thy thy';
wneuper@59269
   371
        val {rew_ord' = ro', erls = erls, ...} = Specify.get_met (get_obj g_metID pt pp);
neuper@42394
   372
        val (f, p) = case p_ of (*p 12.4.00 unnecessary*)
neuper@42394
   373
                      Frm => (get_obj g_form pt p, p)
neuper@42394
   374
                    | Res => ((fst o (get_obj g_result pt)) p, lev_on p)
neuper@42394
   375
                    | _ => error ("applicable_in: call by " ^ pos'2str (p,p_));
neuper@42394
   376
      in 
neuper@42394
   377
        let
neuper@42394
   378
          val subst = subs2subst thy subs;
neuper@42394
   379
          val subs' = subst2subs' subst;
wneuper@59253
   380
        in case rewrite_inst_ thy (assoc_rew_ord ro') erls false subst (snd thm'') f of
neuper@42394
   381
             SOME (f',asm) =>
wneuper@59265
   382
               Chead.Appl (Rewrite_Inst' (thy', ro', erls, false, subst, thm'', f, (f', asm)))
wneuper@59265
   383
           | NONE => Chead.Notappl ((fst thm'')^" not applicable")
neuper@42394
   384
        end
wneuper@59265
   385
        handle _ => Chead.Notappl ("syntax error in "^(subs2str subs))
neuper@42394
   386
      end
neuper@37906
   387
wneuper@59250
   388
| applicable_in (p,p_) pt (m as Rewrite thm'') = 
neuper@37935
   389
  if member op = [Pbl,Met] p_ 
wneuper@59265
   390
    then Chead.Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
neuper@37906
   391
  else
wneuper@59250
   392
  let val (msg,thy',ro,rls',(*put_asm*)_)= from_pblobj_or_detail_thm thm'' p pt;
neuper@37906
   393
    val thy = assoc_thy thy';
neuper@37906
   394
    val f = case p_ of
neuper@37906
   395
              Frm => get_obj g_form pt p
neuper@37906
   396
	    | Res => (fst o (get_obj g_result pt)) p
neuper@38031
   397
	    | _ => error ("applicable_in Rewrite: call by "^
neuper@37906
   398
				(pos'2str (p,p_)));
neuper@37906
   399
  in if msg = "OK" 
neuper@37906
   400
     then
wneuper@59253
   401
        case rewrite_ thy (assoc_rew_ord ro) rls' false (snd thm'') f of
wneuper@59265
   402
         SOME (f',asm) => Chead.Appl (Rewrite' (thy', ro, rls', false, thm'', f, (f', asm)))
wneuper@59265
   403
       | NONE => Chead.Notappl ("'" ^ fst thm'' ^"' not applicable") 
wneuper@59265
   404
     else Chead.Notappl msg
neuper@37906
   405
  end
neuper@37906
   406
wneuper@59250
   407
| applicable_in (p,p_) pt (m as Rewrite_Asm thm'') = 
neuper@37935
   408
  if member op = [Pbl,Met] p_ 
wneuper@59265
   409
    then Chead.Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
neuper@37906
   410
  else
neuper@37906
   411
  let 
neuper@37906
   412
    val pp = par_pblobj pt p; 
neuper@37906
   413
    val thy' = (get_obj g_domID pt pp):theory';
neuper@37906
   414
    val thy = assoc_thy thy';
wneuper@59269
   415
    val {rew_ord'=ro',erls=erls,...} = Specify.get_met (get_obj g_metID pt pp);
neuper@37906
   416
    (*val put_asm = true;*)
wneuper@59250
   417
    val (f, _) = case p_ of
neuper@37906
   418
              Frm => (get_obj g_form pt p, p)
neuper@37906
   419
	    | Res => ((fst o (get_obj g_result pt)) p, lev_on p)
neuper@38031
   420
	    | _ => error ("applicable_in: call by "^
neuper@37906
   421
				(pos'2str (p,p_)));
wneuper@59253
   422
  in case rewrite_ thy (assoc_rew_ord ro') erls false (snd thm'') f of
wneuper@59265
   423
       SOME (f',asm) => Chead.Appl (
wneuper@59253
   424
	   Rewrite' (thy', ro', erls, false, thm'', f, (f', asm)))
wneuper@59265
   425
     | NONE => Chead.Notappl ("'" ^ fst thm'' ^ "' not applicable") end
neuper@37906
   426
neuper@37906
   427
  | applicable_in (p,p_) pt (m as Detail_Set_Inst (subs, rls)) = 
neuper@37935
   428
  if member op = [Pbl,Met] p_ 
wneuper@59265
   429
    then Chead.Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
neuper@37906
   430
  else
neuper@37906
   431
  let 
neuper@37906
   432
    val pp = par_pblobj pt p;
neuper@37906
   433
    val thy' = (get_obj g_domID pt pp):theory';
neuper@37906
   434
    val thy = assoc_thy thy';
wneuper@59269
   435
    val {rew_ord'=ro',...} = Specify.get_met (get_obj g_metID pt pp);
neuper@37906
   436
    val f = case p_ of Frm => get_obj g_form pt p
neuper@37906
   437
		     | Res => (fst o (get_obj g_result pt)) p
neuper@38031
   438
		     | _ => error ("applicable_in: call by "^
neuper@37906
   439
					 (pos'2str (p,p_)));
neuper@37906
   440
  in 
neuper@37906
   441
      let val subst = subs2subst thy subs
neuper@37906
   442
	  val subs' = subst2subs' subst
neuper@37906
   443
      in case rewrite_set_inst_ thy false subst (assoc_rls rls) f of
wneuper@59265
   444
      SOME (f',asm) => Chead.Appl (
neuper@37906
   445
	  Detail_Set_Inst' (thy',false,subst,assoc_rls rls, f, (f', asm)))
wneuper@59265
   446
    | NONE => Chead.Notappl (rls^" not applicable") end
wneuper@59265
   447
  handle _ => Chead.Notappl ("syntax error in "^(subs2str subs)) end
neuper@37906
   448
neuper@37906
   449
  | applicable_in (p,p_) pt (m as Rewrite_Set_Inst (subs, rls)) = 
neuper@37935
   450
  if member op = [Pbl,Met] p_ 
wneuper@59265
   451
    then Chead.Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
neuper@37906
   452
  else
neuper@37906
   453
  let 
neuper@37906
   454
    val pp = par_pblobj pt p;
neuper@37906
   455
    val thy' = (get_obj g_domID pt pp):theory';
neuper@37906
   456
    val thy = assoc_thy thy';
wneuper@59269
   457
    val {rew_ord'=ro',(*asm_rls=asm_rls,*)...} = Specify.get_met (get_obj g_metID pt pp);
neuper@37906
   458
    val (f,p) = case p_ of  (*p 12.4.00 unnecessary*)
neuper@37906
   459
              Frm => (get_obj g_form pt p, p)
neuper@37906
   460
	    | Res => ((fst o (get_obj g_result pt)) p, lev_on p)
neuper@38031
   461
	    | _ => error ("applicable_in: call by "^
neuper@37906
   462
				(pos'2str (p,p_)));
neuper@37906
   463
  in 
neuper@37906
   464
    let val subst = subs2subst thy subs;
neuper@37906
   465
	val subs' = subst2subs' subst;
neuper@37906
   466
    in case rewrite_set_inst_ thy (*put_asm*)false subst (assoc_rls rls) f of
wneuper@59265
   467
      SOME (f',asm) => Chead.Appl (
neuper@37906
   468
	  Rewrite_Set_Inst' (thy',(*put_asm*)false,subst,assoc_rls rls, f, (f', asm)))
wneuper@59265
   469
    | NONE => Chead.Notappl (rls^" not applicable") end
wneuper@59265
   470
  handle _ => Chead.Notappl ("syntax error in "^(subs2str subs)) end
neuper@37906
   471
neuper@37906
   472
  | applicable_in (p,p_) pt (m as Rewrite_Set rls) = 
neuper@37935
   473
  if member op = [Pbl,Met] p_ 
wneuper@59265
   474
    then Chead.Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
neuper@37906
   475
  else
neuper@37906
   476
  let 
neuper@37906
   477
    val pp = par_pblobj pt p; 
neuper@37906
   478
    val thy' = (get_obj g_domID pt pp):theory';
neuper@37906
   479
    val (f,p) = case p_ of  (*p 12.4.00 unnecessary*)
neuper@37906
   480
              Frm => (get_obj g_form pt p, p)
neuper@37906
   481
	    | Res => ((fst o (get_obj g_result pt)) p, lev_on p)
neuper@38031
   482
	    | _ => error ("applicable_in: call by "^
neuper@37906
   483
				(pos'2str (p,p_)));
neuper@37930
   484
  in case rewrite_set_ (assoc_thy thy') false (assoc_rls rls) f of
neuper@37926
   485
       SOME (f',asm) => 
neuper@38015
   486
	((*tracing("#.# applicable_in Rewrite_Set,2f'= "^f');*)
wneuper@59265
   487
	 Chead.Appl (Rewrite_Set' (thy',(*put_asm*)false,assoc_rls rls, f, (f', asm)))
neuper@37906
   488
	 )
wneuper@59265
   489
     | NONE => Chead.Notappl (rls^" not applicable") end
neuper@37906
   490
neuper@37906
   491
  | applicable_in (p,p_) pt (m as Detail_Set rls) =
neuper@37935
   492
    if member op = [Pbl,Met] p_ 
wneuper@59265
   493
    then Chead.Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
neuper@37906
   494
    else
neuper@37906
   495
	let val pp = par_pblobj pt p 
neuper@37906
   496
	    val thy' = (get_obj g_domID pt pp):theory'
neuper@37906
   497
	    val f = case p_ of
neuper@37906
   498
			Frm => get_obj g_form pt p
neuper@37906
   499
		      | Res => (fst o (get_obj g_result pt)) p
neuper@38031
   500
		      | _ => error ("applicable_in: call by "^
neuper@37906
   501
					  (pos'2str (p,p_)));
neuper@37906
   502
	in case rewrite_set_ (assoc_thy thy') false (assoc_rls rls) f of
neuper@37926
   503
	       SOME (f',asm) => 
wneuper@59265
   504
	       Chead.Appl (Detail_Set' (thy',false,assoc_rls rls, f, (f',asm)))
wneuper@59265
   505
	     | NONE => Chead.Notappl (rls^" not applicable") end
neuper@37906
   506
neuper@37906
   507
neuper@37906
   508
  | applicable_in p pt (End_Ruleset) = 
neuper@38031
   509
  error ("applicable_in: not impl. for "^
neuper@37906
   510
	       (tac2str End_Ruleset))
neuper@37906
   511
neuper@37906
   512
(* val ((p,p_), pt, (m as Calculate op_)) = (p, pt, m);
neuper@37906
   513
   *)
neuper@37906
   514
| applicable_in (p,p_) pt (m as Calculate op_) = 
neuper@37935
   515
  if member op = [Pbl,Met] p_
wneuper@59265
   516
    then Chead.Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
neuper@37906
   517
  else
neuper@37906
   518
  let 
neuper@37906
   519
    val (msg,thy',isa_fn) = from_pblobj_or_detail_calc op_ p pt;
neuper@37906
   520
    val f = case p_ of
neuper@37906
   521
              Frm => get_obj g_form pt p
neuper@37906
   522
	    | Res => (fst o (get_obj g_result pt)) p
neuper@37906
   523
  in if msg = "OK" then
neuper@37906
   524
	 case calculate_ (assoc_thy thy') isa_fn f of
neuper@37926
   525
	     SOME (f', (id, thm)) => 
wneuper@59265
   526
	     Chead.Appl (Calculate' (thy',op_, f, (f', (id, string_of_thmI thm))))
wneuper@59265
   527
	   | NONE => Chead.Notappl ("'calculate "^op_^"' not applicable") 
wneuper@59265
   528
     else Chead.Notappl msg
neuper@37906
   529
  end
neuper@37906
   530
neuper@37906
   531
(*Substitute combines two different kind of "substitution":
neuper@37906
   532
  (1) subst_atomic: for ?a..?z
neuper@37906
   533
  (2) Pattern.match: for solving equational systems 
neuper@37906
   534
      (which raises exn for ?a..?z)*)
neuper@37906
   535
  | applicable_in (p,p_) pt (m as Substitute sube) = 
neuper@42360
   536
      if member op = [Pbl,Met] p_ 
wneuper@59265
   537
      then Chead.Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
neuper@42360
   538
      else 
neuper@42360
   539
        let
neuper@42360
   540
          val pp = par_pblobj pt p
neuper@42360
   541
          val thy = assoc_thy (get_obj g_domID pt pp)
neuper@42360
   542
          val f = case p_ of
neuper@42360
   543
		        Frm => get_obj g_form pt p
neuper@42360
   544
		      | Res => (fst o (get_obj g_result pt)) p
wneuper@59269
   545
		      val {rew_ord',erls,...} = Specify.get_met (get_obj g_metID pt pp)
neuper@42360
   546
		      val subte = sube2subte sube
neuper@42360
   547
		      val subst = sube2subst thy sube
neuper@42360
   548
		      val ro = assoc_rew_ord rew_ord'
neuper@42360
   549
		    in
neuper@42360
   550
		      if foldl and_ (true, map contains_Var subte)
neuper@42360
   551
		      (*1*)
neuper@42360
   552
		      then
neuper@42360
   553
		        let val f' = subst_atomic subst f
wneuper@59265
   554
		        in if f = f' then Chead.Notappl (sube2str sube^" not applicable")
wneuper@59265
   555
		           else Chead.Appl (Substitute' (ro, erls, subte, f, f'))
neuper@42360
   556
		        end
neuper@42360
   557
		        (*2*)
neuper@42360
   558
		      else 
neuper@42360
   559
		        case rewrite_terms_ thy ro erls subte f of
wneuper@59265
   560
		            SOME (f', _) =>  Chead.Appl (Substitute' (ro, erls, subte, f, f'))
wneuper@59265
   561
		          | NONE => Chead.Notappl (sube2str sube^" not applicable")
neuper@42360
   562
		    end
neuper@37906
   563
neuper@37906
   564
  | applicable_in p pt (Apply_Assumption cts') = 
neuper@41993
   565
      (error ("applicable_in: not impl. for " ^ (tac2str (Apply_Assumption cts'))))
neuper@37906
   566
  
neuper@37906
   567
  (*'logical' applicability wrt. script in locate: Inconsistent?*)
neuper@37906
   568
  | applicable_in (p,p_) pt (m as Take ct') = 
neuper@41993
   569
      if member op = [Pbl,Met] p_ 
wneuper@59265
   570
      then Chead.Notappl (tac2str m ^ " not for pos " ^ pos'2str (p,p_))
neuper@41993
   571
      else
neuper@41993
   572
        let val thy' = get_obj g_domID pt (par_pblobj pt p);
neuper@41993
   573
        in (case parseNEW (assoc_thy thy' |> thy2ctxt) ct' of
wneuper@59265
   574
	            SOME ct => Chead.Appl (Take' ct)
wneuper@59265
   575
	          | NONE => Chead.Notappl ("syntax error in " ^ ct'))
neuper@41993
   576
        end
neuper@37906
   577
neuper@37906
   578
  | applicable_in p pt (Take_Inst ct') = 
neuper@41993
   579
      error ("applicable_in: not impl. for " ^ tac2str (Take_Inst ct'))
neuper@37906
   580
  | applicable_in p pt (Group (con, ints)) = 
neuper@41993
   581
      error ("applicable_in: not impl. for " ^ tac2str (Group (con, ints)))
neuper@37906
   582
neuper@37906
   583
  | applicable_in (p,p_) pt (m as Subproblem (domID, pblID)) = 
neuper@37935
   584
     if member op = [Pbl,Met] p_
neuper@41993
   585
     then (*maybe Apply_Method has already been done FIXME.WN150511: declare_constraints*)
neuper@41993
   586
	      case get_obj g_env pt p of
neuper@41993
   587
	        SOME is => 
wneuper@59265
   588
            Chead.Appl (Subproblem' ((domID, pblID, e_metID), [], 
neuper@41993
   589
					    e_term, [], e_ctxt(*FIXME.WN150511*), subpbl domID pblID))
wneuper@59265
   590
	      | NONE => Chead.Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
neuper@37906
   591
     else (*somewhere later in the script*)
wneuper@59265
   592
       Chead.Appl (Subproblem' ((domID, pblID, e_metID), [], 
neuper@41993
   593
			   e_term, [], e_ctxt, subpbl domID pblID))
neuper@37906
   594
neuper@37906
   595
  | applicable_in p pt (End_Subproblem) =
neuper@41993
   596
      error ("applicable_in: not impl. for " ^ tac2str End_Subproblem)
neuper@37906
   597
  | applicable_in p pt (CAScmd ct') = 
neuper@41993
   598
      error ("applicable_in: not impl. for " ^ tac2str (CAScmd ct'))  
neuper@37906
   599
  | applicable_in p pt (Split_And) = 
neuper@41993
   600
      error ("applicable_in: not impl. for " ^ tac2str Split_And)
neuper@37906
   601
  | applicable_in p pt (Conclude_And) = 
neuper@41993
   602
      error ("applicable_in: not impl. for " ^ tac2str Conclude_And)
neuper@37906
   603
  | applicable_in p pt (Split_Or) = 
neuper@41993
   604
      error ("applicable_in: not impl. for " ^ tac2str Split_Or)
neuper@37906
   605
  | applicable_in p pt (Conclude_Or) = 
neuper@41993
   606
      error ("applicable_in: not impl. for " ^ tac2str Conclude_Or)
neuper@37906
   607
neuper@37906
   608
  | applicable_in (p,p_) pt (Begin_Trans) =
neuper@37906
   609
    let
neuper@37906
   610
      val (f,p) = case p_ of   (*p 12.4.00 unnecessary*)
neuper@37906
   611
	                             (*_____ implizit Take in gen*)
neuper@37906
   612
	Frm => (get_obj g_form pt p, (lev_on o lev_dn) p)
neuper@37906
   613
      | Res => ((fst o (get_obj g_result pt)) p, (lev_on o lev_dn o lev_on) p)
neuper@38031
   614
      | _ => error ("applicable_in: call by "^
neuper@37906
   615
				(pos'2str (p,p_)));
neuper@37906
   616
      val thy' = get_obj g_domID pt (par_pblobj pt p);
wneuper@59265
   617
    in (Chead.Appl (Begin_Trans' f))
neuper@38031
   618
      handle _ => error ("applicable_in: Begin_Trans finds \
neuper@37906
   619
                               \syntaxerror in '"^(term2str f)^"'") end
neuper@37906
   620
neuper@37906
   621
    (*TODO: check parent branches*)
neuper@37906
   622
  | applicable_in (p,p_) pt (End_Trans) =
neuper@37906
   623
    let val thy' = get_obj g_domID pt (par_pblobj pt p);
neuper@37906
   624
    in if p_ = Res 
wneuper@59265
   625
	     then Chead.Appl (End_Trans' (get_obj g_result pt p))
wneuper@59265
   626
       else Chead.Notappl "'End_Trans' is not applicable at the beginning of a transitive sequence"
neuper@42394
   627
       (*TODO: check parent branches*)
neuper@37906
   628
    end
neuper@42394
   629
  | applicable_in p pt (Begin_Sequ) = 
neuper@42394
   630
      error ("applicable_in: not impl. for " ^ tac2str (Begin_Sequ))
neuper@42394
   631
  | applicable_in p pt (End_Sequ) = 
neuper@42394
   632
      error ("applicable_in: not impl. for " ^ tac2str (End_Sequ))
neuper@42394
   633
  | applicable_in p pt (Split_Intersect) = 
neuper@42394
   634
      error ("applicable_in: not impl. for " ^ tac2str (Split_Intersect))
neuper@42394
   635
  | applicable_in p pt (End_Intersect) = 
neuper@42394
   636
      error ("applicable_in: not impl. for " ^ tac2str (End_Intersect))
neuper@37906
   637
neuper@37906
   638
  | applicable_in (p,p_) pt (m as Check_elementwise pred) = 
neuper@42394
   639
    if member op = [Pbl,Met] p_ 
wneuper@59265
   640
    then Chead.Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
neuper@42394
   641
    else
neuper@42394
   642
      let 
neuper@42394
   643
        val pp = par_pblobj pt p; 
neuper@42394
   644
        val thy' = (get_obj g_domID pt pp):theory';
neuper@42394
   645
        val thy = assoc_thy thy'
neuper@42394
   646
        val metID = (get_obj g_metID pt pp)
wneuper@59269
   647
        val {crls,...} =  Specify.get_met metID
neuper@42394
   648
        val (f,asm) = case p_ of Frm => (get_obj g_form pt p , [])
neuper@42394
   649
                               | Res => get_obj g_result pt p;
neuper@42394
   650
        val vp = (thy2ctxt thy, pred) |-> parseNEW |> the |> mk_set thy pt p f;
neuper@42394
   651
      in case f of
neuper@42394
   652
           Const ("List.list.Cons",_) $ _ $ _ =>
wneuper@59265
   653
             Chead.Appl (Check_elementwise' (f, pred, check_elementwise thy crls f vp))
neuper@42394
   654
         | Const ("Tools.UniversalList",_) => 
wneuper@59265
   655
             Chead.Appl (Check_elementwise' (f, pred, (f,asm)))
neuper@42394
   656
         | Const ("List.list.Nil",_) => 
wneuper@59265
   657
             Chead.Appl (Check_elementwise' (f, pred, (f, asm)))
wneuper@59265
   658
         | _ => Chead.Notappl ("Check_elementwise not applicable: "^(term2str f)^" should be constants")
neuper@42394
   659
      end
neuper@37906
   660
neuper@37906
   661
  | applicable_in (p,p_) pt Or_to_List = 
neuper@37935
   662
  if member op = [Pbl,Met] p_ 
wneuper@59265
   663
    then Chead.Notappl ((tac2str Or_to_List)^" not for pos "^(pos'2str (p,p_)))
neuper@37906
   664
  else
neuper@37906
   665
  let 
neuper@37906
   666
    val pp = par_pblobj pt p; 
neuper@37906
   667
    val thy' = (get_obj g_domID pt pp):theory';
neuper@37906
   668
    val thy = assoc_thy thy';
neuper@37906
   669
    val f = case p_ of
neuper@37906
   670
              Frm => get_obj g_form pt p
neuper@37906
   671
	    | Res => (fst o (get_obj g_result pt)) p;
neuper@37906
   672
  in (let val ls = or2list f
wneuper@59265
   673
      in Chead.Appl (Or_to_List' (f, ls)) end) 
wneuper@59265
   674
     handle _ => Chead.Notappl ("'Or_to_List' not applicable to "^(term2str f))
neuper@37906
   675
  end
neuper@37906
   676
neuper@37906
   677
  | applicable_in p pt (Collect_Trues) = 
neuper@38031
   678
  error ("applicable_in: not impl. for "^
neuper@37906
   679
	       (tac2str (Collect_Trues)))
neuper@37906
   680
neuper@37906
   681
  | applicable_in p pt (Empty_Tac) = 
wneuper@59265
   682
  Chead.Notappl "Empty_Tac is not applicable"
neuper@37906
   683
neuper@41933
   684
  | applicable_in (p,p_) pt (Tac id) =
neuper@37906
   685
  let 
neuper@37906
   686
    val pp = par_pblobj pt p; 
neuper@37906
   687
    val thy' = (get_obj g_domID pt pp):theory';
neuper@37906
   688
    val thy = assoc_thy thy';
neuper@37906
   689
    val f = case p_ of
neuper@37906
   690
              Frm => get_obj g_form pt p
neuper@41933
   691
            | Pbl => error "applicable_in (p,Pbl) pt (Tac id): not at Pbl"
neuper@37906
   692
	    | Res => (fst o (get_obj g_result pt)) p;
neuper@37906
   693
  in case id of
neuper@37906
   694
      "subproblem_equation_dummy" =>
neuper@37906
   695
	  if is_expliceq f
wneuper@59265
   696
	  then Chead.Appl (Tac_ (thy, term2str f, id,
neuper@37906
   697
			     "subproblem_equation_dummy ("^(term2str f)^")"))
wneuper@59265
   698
	  else Chead.Notappl "applicable only to equations made explicit"
neuper@37906
   699
    | "solve_equation_dummy" =>
neuper@38015
   700
	  let (*val _= tracing("### applicable_in: solve_equation_dummy: f= "
neuper@37906
   701
				 ^f);*)
neuper@37906
   702
	    val (id',f') = split_dummy (term2str f);
neuper@38015
   703
	    (*val _= tracing("### applicable_in: f'= "^f');*)
wneuper@59186
   704
	    (*val _= (Thm.term_of o the o (parse thy)) f';*)
neuper@38015
   705
	    (*val _= tracing"### applicable_in: solve_equation_dummy";*)
wneuper@59265
   706
	  in if id' <> "subproblem_equation_dummy" then Chead.Notappl "no subproblem"
bonzai@41952
   707
	     else if (thy2ctxt thy, f') |-> parseNEW |> the |> is_expliceq
wneuper@59265
   708
		      then Chead.Appl (Tac_ (thy, term2str f, id, "[" ^ f' ^ "]"))
neuper@37906
   709
		  else error ("applicable_in: f= " ^ f') end
wneuper@59265
   710
    | _ => Chead.Appl (Tac_ (thy, term2str f, id, term2str f)) end
neuper@37906
   711
wneuper@59265
   712
  | applicable_in p pt End_Proof' = Chead.Appl End_Proof''
neuper@37906
   713
neuper@37906
   714
  | applicable_in _ _ m = 
neuper@38031
   715
  error ("applicable_in called for "^(tac2str m));
neuper@37906
   716
neuper@37906
   717
(*WN060614 unused*)
neuper@37906
   718
fun tac2tac_ pt p m = 
neuper@37906
   719
    case applicable_in p pt m of
wneuper@59265
   720
	Chead.Appl (m') => m' 
wneuper@59265
   721
      | Chead.Notappl _ => error ("tac2mstp': fails with"^
neuper@37906
   722
				  (tac2str m));
neuper@37906
   723
wneuper@59272
   724
end