src/Tools/isac/MathEngBasic/tactic.sml
author wneuper <Walther.Neuper@jku.at>
Tue, 10 Jan 2023 17:07:53 +0100
changeset 60647 ea7db4f4f837
parent 60645 43e858cf9567
child 60655 f73460617c3d
permissions -rw-r--r--
eliminate use of Thy_Info 10: arg. ctxt for Rule.to_string finished
     1 (* Title: "MathEngBasic/tactic.sml"
     2    Author: Walther Neuper 170121
     3    (c) due to copyright terms
     4 
     5 Tactics; tac_ for interaction with frontend, input for internal use.
     6 
     7 Regular expression for search:
     8 Add_Find|Add_Given|Add_Relation|Apply_Method|Begin_Sequ|Begin_Trans|Split_And|Split_Or|Split_Intersect|Conclude_And|Conclude_Or|End_Sequ|End_Trans|End_Ruleset|End_Subproblem|End_Intersect|End_Proof|Calculate|Check_Postcond|Check_elementwise|Del_Find|Del_Given|Del_Relation|Derive|Detail_Set|Detail_Set_Inst|End_Detail|Empty_Tac|Free_Solve|Init_Proof|Model_Problem Or_to_List|Refine_Problem|Refine_Tacitly| Rewrite|Rewrite_Inst|Rewrite_Set|Rewrite_Set_Inst|Specify_Method|Specify_Problem|Specify_Theory|Subproblem|Substitute|Tac|Take|Take_Inst
     9 
    10 *)
    11 signature TACTIC =
    12 sig
    13   datatype T =
    14     Add_Find' of TermC.as_string * Model_Def.i_model | Add_Given' of TermC.as_string * Model_Def.i_model 
    15   | Add_Relation' of TermC.as_string * Model_Def.i_model
    16 (*RM*)| Del_Find' of TermC.as_string | Del_Given' of TermC.as_string | Del_Relation' of TermC.as_string
    17   | Model_Problem' of Problem.id * Model_Def.i_model * Model_Def.i_model
    18   | Refine_Problem' of Problem.id * (Model_Def.i_model * Pre_Conds_Def.T)
    19   | Refine_Tacitly' of Problem.id * Problem.id * ThyC.id * MethodC.id * Model_Def.i_model
    20   | Specify_Method' of MethodC.id * Model_Def.o_model * Model_Def.i_model
    21   | Specify_Problem' of Problem.id * (bool * (Model_Def.i_model * Pre_Conds_Def.T))
    22   | Specify_Theory' of ThyC.id
    23   (* ^^^^^--------------------- for specify-phase, for solve-phase ---------------------vvvvv*)
    24   | Apply_Method' of MethodC.id * term option * Istate_Def.T * Proof.context
    25   | Calculate' of ThyC.id * string * term * (term * ThmC.T)
    26   | Check_Postcond' of Problem.id * term
    27   | Check_elementwise' of term * TermC.as_string * Celem.result
    28   | Derive' of Rule_Set.T    
    29   | Empty_Tac_
    30   | Free_Solve'
    31   | Or_to_List' of term * term
    32   | Rewrite' of ThyC.id * Rewrite_Ord.id * Rule_Set.T * bool * ThmC.T * term * Celem.result
    33   | Rewrite_Inst' of ThyC.id * Rewrite_Ord.id * Rule_Set.T * bool * subst * ThmC.T * term * Celem.result
    34   | Rewrite_Set' of ThyC.id * bool * Rule_Set.T * term * Celem.result
    35   | Rewrite_Set_Inst' of ThyC.id * bool * subst * Rule_Set.T * term * Celem.result
    36   | Subproblem' of References_Def.T * Model_Def.o_model * term * Model_Def.form_model * Proof.context * term
    37   | Substitute' of Rewrite_Ord.function * Rule_Set.T * Subst.as_eqs * term * term
    38 (*RM*)| Tac_ of theory * string * string * string
    39   | Take' of term
    40   | End_Detail' of Celem.result
    41   | Begin_Trans' of term | End_Trans' of Celem.result
    42   | End_Proof''
    43 
    44   val string_of: T -> string
    45 
    46   datatype input =
    47     Add_Find of TermC.as_string | Add_Given of TermC.as_string
    48   | Add_Relation of TermC.as_string
    49   | Del_Find of TermC.as_string | Del_Given of TermC.as_string | Del_Relation of TermC.as_string
    50   | Model_Problem
    51   | Refine_Problem of Problem.id
    52   | Refine_Tacitly of Problem.id
    53   | Specify_Method of MethodC.id
    54   | Specify_Problem of Problem.id
    55   | Specify_Theory of ThyC.id
    56   (* ^^^^^--------------------- for specify-phase, for solve-phase ---------------------vvvvv*)
    57   | Apply_Method of MethodC.id
    58   | Calculate of string
    59   | Check_Postcond of Problem.id
    60   | Check_elementwise of TermC.as_string
    61   | Derive of Rule_Set.id
    62   | Empty_Tac
    63   | Free_Solve
    64   | Or_to_List
    65   | Rewrite of ThmC.T
    66   | Rewrite_Inst of Subst.input * ThmC.T
    67   | Rewrite_Set of Rule_Set.id
    68   | Rewrite_Set_Inst of Subst.input * Rule_Set.id
    69   | Subproblem of ThyC.id * Problem.id
    70   | Substitute of Subst.input
    71 (*RM*)| Tac of string
    72   | Take of TermC.as_string
    73   | End_Detail
    74   | Begin_Trans | End_Trans
    75   | End_Proof';
    76 
    77   type subst_input
    78   val subst_adapt_to_type: Proof.context -> subst_input -> Subst.T
    79 
    80   val input_to_string : Proof.context -> input -> string
    81   val tac2IDstr : input -> string
    82   val is_empty : input -> bool
    83 
    84   val eq_tac : input * input -> bool
    85   val is_rewtac : input -> bool
    86   val is_rewset : input -> bool
    87   val rls_of : input -> Rule_Set.id
    88   val rule2tac : Proof.context -> Env.T ->  Rule.rule -> input
    89   val applicable : Proof.context -> string -> Rule_Set.T -> term -> input ->input list
    90   val for_specify: input -> bool
    91 
    92   val input_from_T : Proof.context -> T -> input
    93   val result : T -> term
    94   val creates_assms: T -> term list
    95   val insert_assumptions: T -> Proof.context -> Proof.context
    96   val for_specify': T -> bool
    97 end
    98 
    99 (**)
   100 structure Tactic(**): TACTIC(**) =
   101 struct
   102 (**)
   103 
   104 (** conversion from input-terms to terms in \<open>Calc.T\<close> **)
   105 (*
   106   A Tactic are input with string-arguments;
   107   while parsing these require \<open>adapt_to_type\<close> for \<open>Calc.T\<close>.
   108 *)
   109 type subst_input = string list
   110 val dummyT = TFree ("'a", ["HOL.type"]);
   111 
   112 fun subst_adapt_to_type ctxt subst = (subst
   113   |> map (TermC.parse ctxt)
   114   |> map TermC.isapair2pair (*replace by HOLogic.strip_tuple etc*)
   115   |> map (apfst HOLogic.dest_string)
   116   |> map (apfst (fn str => (TermC.mk_Free (str, dummyT))))
   117   |> map (fn (t1, t2) =>
   118     (Model_Pattern.adapt_term_to_type ctxt t1, Model_Pattern.adapt_term_to_type ctxt t2)))
   119   handle TERM _ => raise TERM ("Tactic.subst_adapt_to_type: wrong argument " ^ strs2str' subst, [])
   120 
   121 
   122 (** tactics for user at front-end **)
   123 
   124 datatype input =
   125     Add_Find of TermC.as_string | Add_Given of TermC.as_string | Add_Relation of TermC.as_string
   126   | Del_Find of TermC.as_string | Del_Given of TermC.as_string | Del_Relation of TermC.as_string
   127   | Model_Problem
   128   | Refine_Problem of Problem.id
   129   | Refine_Tacitly of Problem.id
   130   | Specify_Method of MethodC.id
   131   | Specify_Problem of Problem.id
   132   | Specify_Theory of ThyC.id
   133   (* ^^^^^--------------------- for specify-phase, for solve-phase ---------------------vvvvv*)
   134   | Apply_Method of MethodC.id
   135   | Calculate of string
   136   | Check_Postcond of Problem.id
   137   | Check_elementwise of TermC.as_string
   138   | Derive of Rule_Set.id
   139   | Empty_Tac
   140   | Free_Solve
   141   | Or_to_List
   142   | Rewrite of ThmC.T
   143   | Rewrite_Inst of Subst.input * ThmC.T
   144   | Rewrite_Set of Rule_Set.id
   145   | Rewrite_Set_Inst of Subst.input * Rule_Set.id
   146   | Subproblem of ThyC.id * Problem.id
   147   | Substitute of Subst.input
   148 (*RM*)| Tac of string
   149   | Take of TermC.as_string
   150   | End_Detail
   151   | Begin_Trans | End_Trans
   152   | End_Proof';
   153 
   154 fun input_to_string ctxt ma = case ma of
   155     Model_Problem           => "Model_Problem "
   156   | Refine_Tacitly pblID    => "Refine_Tacitly " ^ strs2str pblID 
   157   | Refine_Problem pblID    => "Refine_Problem " ^ strs2str pblID 
   158   | Add_Given cterm'        => "Add_Given " ^ cterm'
   159   | Del_Given cterm'        => "Del_Given " ^ cterm'
   160   | Add_Find cterm'         => "Add_Find " ^ cterm'
   161   | Del_Find cterm'         => "Del_Find " ^ cterm'
   162   | Add_Relation cterm'     => "Add_Relation " ^ cterm'
   163   | Del_Relation cterm'     => "Del_Relation " ^ cterm'
   164 
   165   | Specify_Theory domID    => "Specify_Theory " ^ quote domID
   166   | Specify_Problem pblID   => "Specify_Problem " ^ strs2str pblID
   167   | Specify_Method metID    => "Specify_Method " ^ strs2str metID
   168   | Apply_Method metID      => "Apply_Method " ^ strs2str metID
   169   | Check_Postcond pblID    => "Check_Postcond " ^ strs2str pblID
   170   | Free_Solve              => "Free_Solve"
   171 
   172   | Rewrite_Inst (subs, (id, thm)) => "Rewrite_Inst " ^
   173     (pair2str (subs2str subs, spair2str (id, thm |> Thm.prop_of |> UnparseC.term_in_ctxt ctxt)))
   174   | Rewrite (id, thm) => "Rewrite " ^
   175     spair2str (id, thm |> Thm.prop_of |> UnparseC.term_in_ctxt ctxt)
   176   | Rewrite_Set_Inst (subs, rls) => 
   177     "Rewrite_Set_Inst " ^ pair2str (subs2str subs, quote rls)
   178   | Rewrite_Set rls         => "Rewrite_Set " ^ quote rls
   179   | Begin_Trans              => "Begin_Trans"
   180   | End_Trans              => "End_Trans"
   181   | End_Detail              => "End_Detail"
   182   | Derive rls'             => "Derive " ^ rls'
   183   | Calculate op_           => "Calculate " ^ op_
   184   | Substitute sube         => "Substitute " ^ Subst.string_eqs_to_string sube	     
   185 
   186   | Take cterm'             => "Take " ^ quote cterm'
   187   | Subproblem (domID, pblID) => "Subproblem " ^ pair2str (domID, strs2str pblID)
   188 
   189   | Check_elementwise cterm'=> "Check_elementwise " ^ quote cterm'
   190   | Or_to_List              => "Or_to_List "
   191 
   192   | Empty_Tac               => "Empty_Tac"
   193 (*RM*)| Tac string              => "Tac " ^ string(*RM*)
   194   | End_Proof'              => "input End_Proof'";
   195 
   196 fun tac2IDstr ma = case ma of
   197     Model_Problem => "Model_Problem"
   198   | Refine_Tacitly _ => "Refine_Tacitly"
   199   | Refine_Problem _ => "Refine_Problem"
   200   | Add_Given _ => "Add_Given"
   201   | Del_Given _ => "Del_Given"
   202   | Add_Find _ => "Add_Find"
   203   | Del_Find _ => "Del_Find"
   204   | Add_Relation _ => "Add_Relation"
   205   | Del_Relation _ => "Del_Relation"
   206 
   207   | Specify_Theory _ => "Specify_Theory"
   208   | Specify_Problem _ => "Specify_Problem"
   209   | Specify_Method _ => "Specify_Method"
   210   | Apply_Method _ => "Apply_Method"
   211   | Check_Postcond _ => "Check_Postcond"
   212   | Free_Solve => "Free_Solve"
   213 
   214   | Rewrite_Inst _ => "Rewrite_Inst"
   215   | Rewrite _ => "Rewrite"
   216   | Rewrite_Set_Inst _ => "Rewrite_Set_Inst"
   217   | Rewrite_Set _ => "Rewrite_Set"
   218   | Derive _ => "Derive "
   219   | Calculate _ => "Calculate "
   220   | Substitute _ => "Substitute" 
   221 
   222   | Take _ => "Take"
   223   | Subproblem _ => "Subproblem"
   224 
   225   | Check_elementwise _ => "Check_elementwise"
   226   | Or_to_List => "Or_to_List "
   227 
   228   | Empty_Tac => "Empty_Tac"
   229   | Tac _ => "Tac "
   230   | End_Proof' => "End_Proof'"
   231   | _ => "input_to_string not impl. for ?!";
   232 
   233 fun is_empty input = case input of Empty_Tac => true | _ => false
   234 
   235 fun eq_tac (Rewrite (id1, _), Rewrite (id2, _)) = id1 = id2
   236   | eq_tac (Rewrite_Inst (_, (id1, _)), Rewrite_Inst (_, (id2, _))) = id1 = id2
   237   | eq_tac (Rewrite_Set id1, Rewrite_Set id2) = id1 = id2
   238   | eq_tac (Rewrite_Set_Inst (_, id1), Rewrite_Set_Inst (_, id2)) = id1 = id2
   239   | eq_tac (Calculate id1, Calculate id2) = id1 = id2
   240   | eq_tac _ = false
   241 
   242 fun is_rewset (Rewrite_Set_Inst _) = true
   243   | is_rewset (Rewrite_Set _) = true 
   244   | is_rewset _ = false;
   245 fun is_rewtac (Rewrite _) = true
   246   | is_rewtac (Rewrite_Inst _) = true
   247   | is_rewtac input = is_rewset input;
   248 
   249 
   250 fun rls_of (Rewrite_Set_Inst (_, rls)) = rls
   251   | rls_of (Rewrite_Set rls) = rls
   252   | rls_of input = raise ERROR ("rls_of: called with input \"" ^ tac2IDstr input ^ "\"");
   253 
   254 fun rule2tac ctxt _ (Rule.Eval (opID, _)) = 
   255     Calculate (get_calc_prog_id ctxt opID)
   256   | rule2tac _ [] (Rule.Thm thm'') = Rewrite thm''
   257   | rule2tac ctxt subst (Rule.Thm thm'') = 
   258     Rewrite_Inst (Subst.T_to_input ctxt subst, thm'')
   259   | rule2tac _ [] (Rule.Rls_ rls) = Rewrite_Set (Rule_Set.id rls)
   260   | rule2tac ctxt subst (Rule.Rls_ rls) = 
   261     Rewrite_Set_Inst (Subst.T_to_input ctxt subst, (Rule_Set.id rls))
   262   | rule2tac ctxt _ rule = 
   263     raise ERROR ("rule2tac: called with \"" ^ Rule.to_string ctxt rule ^ "\"");
   264 
   265 (* try if a rewrite-rule is applicable to a given formula; 
   266    in case of rule-sets (recursivley) collect all _atomic_ rewrites *) 
   267 fun try_rew ctxt ((_, ro) : Rewrite_Ord.T) asm_rls (subst : subst) f (thm' as Rule.Thm (_, thm)) =
   268     if Auto_Prog.contains_bdv thm
   269     then case Rewrite.rewrite_inst_ ctxt ro asm_rls false subst thm f of
   270 	    SOME _ => [rule2tac ctxt subst thm']
   271 	  | NONE => []
   272     else (case Rewrite.rewrite_ ctxt ro asm_rls false thm f of
   273 	    SOME _ => [rule2tac ctxt [] thm']
   274 	  | NONE => [])
   275   | try_rew ctxt _ _ _ f (cal as Rule.Eval c) = 
   276     (case Eval.adhoc_thm ctxt c f of
   277 	    SOME _ => [rule2tac ctxt [] cal]
   278     | NONE => [])
   279   | try_rew ctxt _ _ _ f (cal as Rule.Cal1 c) = 
   280     (case Eval.adhoc_thm ctxt c f of
   281 	      SOME _ => [rule2tac ctxt [] cal]
   282       | NONE => [])
   283   | try_rew thy _ _ subst f (Rule.Rls_ rls) = filter_appl_rews thy subst f rls
   284   | try_rew _ _ _ _ _ _ = raise ERROR "try_rew: uncovered case"
   285 and filter_appl_rews thy subst f (Rule_Def.Repeat {rew_ord = ro, asm_rls, rules, ...}) = 
   286     distinct eq_tac (flat (map (try_rew thy ro asm_rls subst f) rules))
   287   | filter_appl_rews thy subst f (Rule_Set.Sequence {rew_ord = ro, asm_rls, rules,...}) = 
   288     distinct eq_tac (flat (map (try_rew thy ro asm_rls subst f) rules))
   289   | filter_appl_rews _ _ _ (Rule_Set.Rrls _) = []
   290   | filter_appl_rews _ _ _ _ = raise ERROR "filter_appl_rews: uncovered case"
   291 
   292 (* decide if a tactic is applicable to a given formula; 
   293    in case of Rewrite_Set* go down to _atomic_ rewrite-tactics *)
   294 fun applicable ctxt _ _ f (Calculate scrID) =
   295     try_rew ctxt Rewrite_Ord.empty Rule_Set.empty [] f 
   296       (Rule.Eval (get_calc ctxt scrID |> snd))
   297   | applicable ctxt ro asm_rls f (Rewrite thm'') =
   298     try_rew ctxt (ro, get_rew_ord ctxt ro) asm_rls [] f (Rule.Thm thm'')
   299   | applicable ctxt ro asm_rls f (Rewrite_Inst (subs, thm'')) =
   300     try_rew ctxt (ro, get_rew_ord ctxt ro) asm_rls 
   301       (subst_adapt_to_type ctxt subs) f (Rule.Thm thm'')
   302 
   303   | applicable ctxt _ _ f (Rewrite_Set rls') =
   304     filter_appl_rews ctxt [] f (get_rls ctxt rls')
   305   | applicable ctxt _ _ f (Rewrite_Set_Inst (subs, rls')) =
   306     filter_appl_rews ctxt (subst_adapt_to_type ctxt subs) f (get_rls ctxt rls')
   307   | applicable ctxt _ _ _ tac = 
   308     (tracing ("### applicable: not impl. for tac = '" ^ input_to_string ctxt tac ^ "'"); []);
   309 
   310 
   311 (** tactics for internal use **)
   312 
   313   datatype T =
   314     Add_Find' of TermC.as_string * Model_Def.i_model | Add_Given' of TermC.as_string * Model_Def.i_model 
   315   | Add_Relation' of TermC.as_string * Model_Def.i_model (* for Step.do_next    *)
   316 (*RM*)| Del_Find' of TermC.as_string | Del_Given' of TermC.as_string | Del_Relation' of TermC.as_string
   317   | Model_Problem' of  (* first step in specify-phase                        *)
   318       Problem.id *     (* id in the Know_Store                               *)
   319       Model_Def.i_model * (* the model for the Problem                          *)
   320       Model_Def.i_model   (* the model for the method                           *)
   321   | Refine_Problem' of Problem.id * (Model_Def.i_model * Pre_Conds_Def.T)
   322   | Refine_Tacitly' of                                                      
   323       Problem.id *       (* the original id in the Know_Store                *)
   324       Problem.id *       (* the id of the refined Problem                    *)
   325       ThyC.id *          (* the id of the refined theory                     *)
   326       MethodC.id *        (* the id of the refined MethodC                     *)
   327       Model_Def.i_model     (* RM 9.03: remains [] for Model_Problem recognizing its activation *)
   328   | Specify_Method' of MethodC.id * Model_Def.o_model * Model_Def.i_model
   329   | Specify_Problem' of Problem.id * 
   330       (bool *                  (* all preconditions evaluate to True         *)
   331         (Model_Def.i_model *      (* the model checked for the input id         *)
   332           Pre_Conds_Def.T)) (* individual preconditions marked true/false *)
   333   | Specify_Theory' of ThyC.id
   334   (* ^^^^^--------------------- for specify-phase, for solve-phase ---------------------vvvvv*)
   335   | Apply_Method' of   (* last step in specifu-phse, switch to solve-phase   *)
   336       MethodC.id *      (* id in the Know_Store                               *)
   337       term option *    (* first formula in the (sub-)Problem TODO: rm option *)           
   338       Istate_Def.T *   (* for starting the Program                           *)
   339       Proof.context    (* for starting the Program                           *)
   340   | Calculate' of ThyC.id * string * term * (term * ThmC.T)
   341   | Check_Postcond' of   (* last step in solving a (sub-)Problem             *)
   342       Problem.id *       (* id of the Problem to be checked                  *)
   343       term               (* return value of the program                      *)
   344   | Check_elementwise' of(* DEPRECATED, made idle for Calc.T in df00a2b5c4cc *)
   345       term *             (* the current formula: [x=1,x=...]                 *)
   346       string *           (* the pred from Check_elementwise                  *)
   347       Celem.result       (* composed from (1) and (2): {x. pred}             *)
   348   | Derive' of Rule_Set.T(* for Test_Out.embed_deriv                         *)
   349   | Empty_Tac_
   350   | Free_Solve'
   351   | Or_to_List' of term * term
   352   | Rewrite' of ThyC.id * Rewrite_Ord.id * Rule_Set.T * bool * ThmC.T * term * Celem.result
   353   | Rewrite_Inst' of ThyC.id * Rewrite_Ord.id * Rule_Set.T * bool * subst * ThmC.T * term * Celem.result
   354   | Rewrite_Set' of ThyC.id * bool * Rule_Set.T * term * Celem.result
   355   | Rewrite_Set_Inst' of ThyC.id * bool * subst * Rule_Set.T * term * Celem.result
   356   | Subproblem' of       (* switch from solve-phase to specify-phase         *)
   357       References_Def.T *           (* specification of the SubProblem                  *)
   358   		(Model_Def.o_model) * (* original model, filled in associate Subproblem'  *)
   359   		term *             (* headline of calc-head, filled -"-                *)
   360   		Model_Def.form_model *       (* string list from arguments of the calling Program*)
   361       Proof.context *    (* for the specify-phase                            *)
   362   		term               (* Subproblem (thyID, pbl) OR CAS_Cmd               *)  
   363   | Substitute' of       (* substitute variables (TODO: from the context)    *)    
   364       Rewrite_Ord.function *(* for re-calculation                               *)
   365       Rule_Set.T *       (* for re-calculation                               *)
   366       Subst.as_eqs *     (* the substitution: terms of type bool             *)
   367       term *             (* to be substituted into                           *)
   368       term               (* resulting from the substitution                  *)
   369 (*RM*)| Tac_ of theory * string * string * string
   370   | Take' of term
   371   | End_Detail' of Celem.result (* for intermediate steps into Rewrite_Set   *)
   372   | Begin_Trans' of term        (* for intermediate steps into Rewrite_Set   *)
   373   | End_Trans' of Celem.result  (* for intermediate steps into Rewrite_Set   *)
   374   | End_Proof''
   375 
   376 fun string_of ma = case ma of
   377     Model_Problem' (pblID, _, _) => "Model_Problem' " ^ strs2str pblID
   378   | Refine_Tacitly'(p, prefin, domID, metID, _) => "Refine_Tacitly' (" ^ strs2str p ^ ", " ^
   379     strs2str prefin ^ ", " ^ domID ^ ", " ^ strs2str metID ^ ", pbl-itms)"
   380   | Refine_Problem' _ => "Refine_Problem' (" ^ (*matchs2str ms*)"..." ^ ")"
   381   | Add_Given' _ => "Add_Given' "(*^cterm'*)
   382   | Del_Given' _ => "Del_Given' "(*^cterm'*)
   383   | Add_Find' _ => "Add_Find' "(*^cterm'*)
   384   | Del_Find' _ => "Del_Find' "(*^cterm'*)
   385   | Add_Relation' _ => "Add_Relation' "(*^cterm'*)
   386   | Del_Relation' _ => "Del_Relation' "(*^cterm'*)
   387 
   388   | Specify_Theory' domID => "Specify_Theory' " ^ quote domID
   389   | Specify_Problem' (pI, (ok, _)) =>  "Specify_Problem' " ^ 
   390     spair2str (strs2str pI, spair2str (bool2str ok, spair2str ("itms2str_ itms", "items2str where_")))
   391   | Specify_Method' (pI, oris, _) => "Specify_Method' (" ^ 
   392     MethodC.id_to_string pI ^ ", " ^ Model_Def.o_model_to_string oris ^ ", )"
   393 
   394   | Apply_Method' (metID, _, _, _) => "Apply_Method' " ^ strs2str metID
   395   | Check_Postcond' (pblID, scval) => "Check_Postcond' " ^
   396       (spair2str (strs2str pblID, UnparseC.term scval))
   397 
   398   | Free_Solve' => "Free_Solve'"
   399 
   400   | Rewrite_Inst' (*subs,thm'*) _ => "Rewrite_Inst' "(*^(pair2str (subs2str subs, spair2str thm'))*)
   401   | Rewrite' _(*thm'*) => "Rewrite' "(*^(spair2str thm')*)
   402   | Rewrite_Set_Inst' _(*subs,thm'*) => "Rewrite_Set_Inst' "(*^(pair2str (subs2str subs, quote rls))*)
   403   | Rewrite_Set' (thy', pasm, rls', f, (f', asm)) => "Rewrite_Set' (" ^ thy' ^ ", " ^ bool2str pasm ^
   404     ", " ^ Rule_Set.id rls' ^ ", " ^ UnparseC.term f ^ ",(" ^ UnparseC.term f' ^ ", " ^ UnparseC.terms asm ^ "))"
   405   | End_Detail' _ => "End_Detail' xxx"
   406 
   407   | Derive' rls => "Derive' " ^ Rule_Set.id rls
   408   | Calculate'  _ => "Calculate' "
   409   | Substitute' _ => "Substitute' "(*^(subs2str subs)*)    
   410 
   411   | Take' _(*cterm'*) => "Take' "(*^(quote cterm'	)*)
   412   | Subproblem' _(*(spec, oris, _, _, _, pbl_form)*) => 
   413     "Subproblem' "(*^(pair2str (domID, strs2str ,))*)
   414 
   415   | Empty_Tac_ => "Empty_Tac_"
   416   | Tac_ (_, form, id, result) => "Tac_ (thy," ^ form ^ ", " ^ id ^ ", " ^ result ^ ")"
   417 
   418   | Begin_Trans' _ => "Begin_Trans' xxx"
   419   | End_Trans' _ => "End_Trans' xxx"
   420   | End_Proof'' => "End_Trans' xxx"
   421   | _  => "string_of not impl. for arg";
   422 
   423 fun input_from_T _ (Refine_Tacitly' (pI, _, _, _, _)) = Refine_Tacitly pI
   424   | input_from_T _ (Model_Problem' (_, _, _)) = Model_Problem
   425   | input_from_T _ (Add_Given' (t, _)) = Add_Given t
   426   | input_from_T _ (Add_Find' (t, _)) = Add_Find t
   427   | input_from_T _ (Add_Relation' (t, _)) = Add_Relation t
   428  
   429   | input_from_T _ (Specify_Theory' dI) = Specify_Theory dI
   430   | input_from_T _ (Specify_Problem' (dI, _)) = Specify_Problem dI
   431   | input_from_T _ (Specify_Method' (dI, _, _)) = Specify_Method dI
   432   
   433   | input_from_T _ (Rewrite' (_, _, _, _, thm, _, _)) = Rewrite thm
   434   | input_from_T ctxt (Rewrite_Inst' (_, _, _, _, sub, thm, _, _)) =
   435     Rewrite_Inst (Subst.T_to_input ctxt sub, thm)
   436 
   437   | input_from_T _ (Rewrite_Set' (_, _, rls, _, _)) = Rewrite_Set (Rule_Set.id rls)
   438   | input_from_T ctxt (Rewrite_Set_Inst' (_, _, sub, rls, _, _)) = 
   439     Rewrite_Set_Inst (Subst.T_to_input ctxt sub, Rule_Set.id rls)
   440 
   441   | input_from_T _ (Calculate' (_, op_, _, _)) = Calculate (op_)
   442   | input_from_T _ (Check_elementwise' (_, pred, _)) = Check_elementwise pred
   443 
   444   | input_from_T _ (Or_to_List' _) = Or_to_List
   445   | input_from_T _ (Take' term) = Take (UnparseC.term term)
   446   | input_from_T _ (Substitute' (_, _, subte, _, _)) = Substitute (Subst.eqs_to_input subte) 
   447   | input_from_T _ (Tac_ (_, _, id, _)) = Tac id
   448 
   449   | input_from_T _ (Subproblem' ((domID, pblID, _), _, _, _,_ ,_)) = Subproblem (domID, pblID)
   450   | input_from_T _ (Check_Postcond' (pblID, _)) = Check_Postcond pblID
   451   | input_from_T _ Empty_Tac_ = Empty_Tac
   452   | input_from_T _ m = raise ERROR (": not impl. for "^(string_of m));
   453 
   454 fun res (Rewrite_Inst' (_ , _, _, _, _, _, _, res)) = res
   455   | res (Rewrite' (_, _, _, _, _, _, res)) = res
   456   | res (Rewrite_Set_Inst' (_, _, _, _, _, res)) = res
   457   | res (Rewrite_Set' (_, _, _, _, res)) = res
   458   | res (Calculate' (_, _, _, (t, _))) = (t, [])
   459   | res (Check_elementwise' (_, _, res)) = res
   460   | res (Subproblem' (_, _, _, _, _, t)) = (t, [])
   461   | res (Take' t) = (t, [])
   462   | res (Substitute' (_, _, _, _, t)) = (t, [])
   463   | res (Or_to_List' (_,  t)) = (t, [])
   464   | res m = raise ERROR ("result: not impl.for " ^ string_of m)
   465 
   466 fun result tac = (fst o res) tac;
   467 fun creates_assms tac = (snd o res) tac;
   468 
   469 fun insert_assumptions tac ctxt  = ContextC.insert_assumptions (creates_assms tac) ctxt
   470 
   471 fun for_specify (Add_Find _) = true
   472   | for_specify (Add_Given _) = true
   473   | for_specify (Add_Relation _) = true
   474   | for_specify (Del_Find _) = true
   475   | for_specify (Del_Given _) = true
   476   | for_specify (Del_Relation _) = true
   477   | for_specify Model_Problem  = true
   478   | for_specify (Refine_Problem _) = true
   479   | for_specify (Refine_Tacitly _) = true
   480   | for_specify (Specify_Method _) = true
   481   | for_specify (Specify_Problem _) = true
   482   | for_specify (Specify_Theory _) = true
   483   | for_specify _ = false
   484 
   485 fun for_specify' (Add_Find' _) = true
   486   | for_specify' (Add_Given' _) = true
   487   | for_specify' (Add_Relation' _) = true
   488   | for_specify' (Del_Find' _) = true
   489   | for_specify' (Del_Given' _) = true
   490   | for_specify' (Del_Relation' _) = true
   491   | for_specify' (Model_Problem' _) = true
   492   | for_specify' (Refine_Problem' _) = true
   493   | for_specify' (Refine_Tacitly' _) = true
   494   | for_specify' (Specify_Method' _) = true
   495   | for_specify' (Specify_Problem' _) = true
   496   | for_specify' (Specify_Theory' _) = true
   497   | for_specify' _ = false
   498 
   499 (**)end(**)