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