src/Tools/isac/MathEngBasic/tactic.sml
author Walther Neuper <walther.neuper@jku.at>
Fri, 01 May 2020 17:17:41 +0200
changeset 59923 cd730f07c9ac
parent 59914 ab5bd5c37e13
child 59924 eb40bce6d6f1
permissions -rw-r--r--
unify sequence of tactics
     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_Assumption|Apply_Method|Begin_Sequ|Begin_Trans|Split_And|Split_Or|Split_Intersect|Conclude_And|Conclude_Or|Collect_Trues|End_Sequ|End_Trans|End_Ruleset|End_Subproblem|End_Intersect|End_Proof|CAScmd|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.itm list | Add_Given' of TermC.as_string * Model.itm list 
    14   | Add_Relation' of TermC.as_string * Model.itm list
    15   | Apply_Method' of Method.id * term option * Istate_Def.T * Proof.context
    16   | Del_Find' of TermC.as_string | Del_Given' of TermC.as_string | Del_Relation' of TermC.as_string
    17   | Init_Proof' of TermC.as_string list * Spec.T
    18   | Model_Problem' of Problem.id * Model.itm list * Model.itm list
    19   | Refine_Problem' of Problem.id * (Model.itm list * (bool * term) list)
    20   | Refine_Tacitly' of Problem.id * Problem.id * ThyC.id * Method.id * Model.itm list
    21   | Specify_Method' of Method.id * Model.ori list * Model.itm list
    22   | Specify_Problem' of Problem.id * (bool * (Model.itm list * (bool * term) list))
    23   | Specify_Theory' of ThyC.id
    24   (* ^^^^^--------------------- for specify-phase, for solve-phase ---------------------vvvvv*)
    25   | CAScmd' of term
    26   | Calculate' of ThyC.id * string * term * (term * ThmC.T)
    27   | Check_Postcond' of Problem.id * term
    28   | Check_elementwise' of term * TermC.as_string * Selem.result
    29 (*RM*)| Derive' of Rule_Set.T      
    30   | Empty_Tac_
    31   | Free_Solve'
    32 (*RM* )| Apply_Assumption of TermC.as_string list( *RM*)
    33   | Or_to_List' of term * term
    34   | Rewrite' of ThyC.id * Rewrite_Ord.rew_ord' * Rule_Set.T * bool * ThmC.T * term * Selem.result
    35   | Rewrite_Inst' of ThyC.id * Rewrite_Ord.rew_ord' * Rule_Set.T * bool * subst * ThmC.T * term * Selem.result
    36   | Rewrite_Set' of ThyC.id * bool * Rule_Set.T * term * Selem.result
    37   | Rewrite_Set_Inst' of ThyC.id * bool * subst * Rule_Set.T * term * Selem.result
    38   | Subproblem' of
    39       Spec.T * Model.ori list *
    40       term *          (* CAScmd, e.g. "solve (-1 + x = 0, x)" *)
    41       Selem.fmz_ *    (* either input to root-probl.  or derived from prog. in ???  *)
    42       (*Istate.T *       ?       *)
    43       Proof.context * (* derived from prog. in ???  *)
    44       term            (* ?UNUSED, e.g."Subproblem\n (''Test'',\n  ??.\<^const>String.char.Char ''LINEAR'' ''univariate'' ''equation''\n   ''test'')" *)
    45   | Substitute' of Rule_Def.rew_ord_ * Rule_Set.T * Subst.as_eqs * term * term
    46 (*RM*)| Tac_ of theory * string * string * string
    47   | Take' of term
    48 (*RM* )| Take_Inst of TermC.as_string( *RM*)
    49 (*RM*)| Begin_Sequ' | Begin_Trans' of term
    50 (*RM*)| Split_And' of term | Split_Or' of term | Split_Intersect' of term
    51 (*RM*)| Conclude_And' of term | Conclude_Or' of term | Collect_Trues' of term
    52 (*RM*)| End_Sequ' | End_Trans' of Selem.result
    53 (*RM*)| End_Ruleset' of term | End_Intersect' of term | End_Proof''
    54 (*RM*)| Detail_Set' of ThyC.id * bool * Rule_Set.T * term * Selem.result
    55 (*RM*)| Detail_Set_Inst' of ThyC.id * bool * subst * Rule_Set.T * term * Selem.result
    56 (*RM*)| End_Detail' of Selem.result;
    57 
    58   val string_of: T -> string
    59 
    60   datatype input =
    61     Add_Find of TermC.as_string | Add_Given of TermC.as_string
    62   | Add_Relation of TermC.as_string
    63   | Apply_Method of Method.id
    64   | Del_Find of TermC.as_string | Del_Given of TermC.as_string | Del_Relation of TermC.as_string
    65   | Init_Proof of TermC.as_string list * Spec.T
    66   | Model_Problem
    67   | Refine_Problem of Problem.id
    68   | Refine_Tacitly of Problem.id
    69   | Specify_Method of Method.id
    70   | Specify_Problem of Problem.id
    71   | Specify_Theory of ThyC.id
    72   (* ^^^^^--------------------- for specify-phase, for solve-phase ---------------------vvvvv*)
    73   | CAScmd of TermC.as_string
    74   | Calculate of string
    75   | Check_Postcond of Problem.id
    76   | Check_elementwise of TermC.as_string
    77 (*RM*)| Derive of Rule_Set.id(*RM*)
    78   | Empty_Tac
    79 (*RM*)| Free_Solve
    80 (*RM*)| Apply_Assumption of TermC.as_string list
    81   | Or_to_List
    82   | Rewrite of ThmC.T
    83   | Rewrite_Inst of Subst.input * ThmC.T
    84   | Rewrite_Set of Rule_Set.id
    85   | Rewrite_Set_Inst of Subst.input * Rule_Set.id
    86   | Subproblem of ThyC.id * Problem.id
    87   | Substitute of Subst.input
    88 (*RM*)| Tac of string
    89   | Take of TermC.as_string
    90 (*RM*)| Take_Inst of TermC.as_string
    91 (*RM*)| Begin_Sequ | Begin_Trans
    92 (*RM*)| Split_And | Split_Or | Split_Intersect
    93 (*RM*)| Conclude_And | Conclude_Or | Collect_Trues
    94 (*RM*)| End_Sequ | End_Trans
    95 (*RM*)| End_Ruleset | End_Subproblem | End_Intersect
    96 (*RM*)| Detail_Set of Rule_Set.id
    97 (*RM*)| Detail_Set_Inst of Subst.input * Rule_Set.id
    98 (*RM*)| End_Detail
    99   | End_Proof';
   100 
   101   val input_to_string : input -> string
   102   val tac2IDstr : input -> string
   103   val is_empty : input -> bool
   104 
   105   val eq_tac : input * input -> bool
   106   val is_rewtac : input -> bool
   107   val is_rewset : input -> bool
   108   val rls_of : input -> Rule_Set.id
   109   val rule2tac : theory -> (term * term) list ->  Rule.rule -> input
   110   val applicable : theory -> string -> Rule_Set.T -> term -> input ->input list
   111   val for_specify: input -> bool
   112 
   113   val input_from_T : T -> input
   114   val result : T -> term
   115   val creates_assms: T -> term list
   116   val insert_assumptions: T -> Proof.context -> Proof.context
   117   val for_specify': T -> bool
   118 
   119 (* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
   120   (* NONE *)
   121 (*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
   122   (* NONE *)
   123 ( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
   124 
   125 (*----- unused code, kept as hints to design ideas ---------------------------------------------*)
   126   (* NONE *)
   127 end
   128 
   129 (**)
   130 structure Tactic(**): TACTIC(**) =
   131 struct
   132 (**)
   133 
   134 (** tactics for user at front-end **)
   135 
   136 (* tactics for user at front-end.
   137    input propagates the construction of the calc-tree;
   138    there are
   139    (a) 'specsteps' for the specify-phase, and others for the solve-phase
   140    (b) those of the solve-phase are 'initac's and others;
   141        initacs start with a formula different from the preceding formula.
   142    see 'type tac_' for the internal representation of tactics
   143 *)
   144 datatype input =
   145     Add_Find of TermC.as_string | Add_Given of TermC.as_string | Add_Relation of TermC.as_string
   146   | Apply_Assumption of TermC.as_string list
   147   | Apply_Method of Method.id
   148     (* creates an "istate" in PblObj.env; in case of "implicit_take" 
   149       creates a formula at ((lev_on o lev_dn) p, Frm) and in this "ppobj.loc"
   150       a "SOME istate" at fst of "loc".
   151       As each step (in the solve-phase) has a resulting formula (at the front-end)
   152       Apply_Method also does the 1st step in the script (an "initac") if there is no "implicit_take" *)  
   153   (*/--- TODO: re-design ? -----------------------------------------------------------------\*)
   154   | Begin_Sequ | Begin_Trans
   155   | Split_And | Split_Or | Split_Intersect
   156   | Conclude_And | Conclude_Or | Collect_Trues
   157   | End_Sequ | End_Trans
   158   | End_Ruleset | End_Subproblem (* WN0509 drop *) | End_Intersect | End_Proof'
   159   (*\--- TODO: re-design ? -----------------------------------------------------------------/*)
   160   | CAScmd of TermC.as_string
   161   | Calculate of string
   162   | Check_Postcond of Problem.id
   163   | Check_elementwise of TermC.as_string
   164   | Del_Find of TermC.as_string | Del_Given of TermC.as_string | Del_Relation of TermC.as_string
   165 
   166   | Derive of Rule_Set.id                 (* WN0509 drop *)
   167   | Detail_Set of Rule_Set.id             (* WN0509 drop *)
   168   | Detail_Set_Inst of Subst.input * Rule_Set.id (* WN0509 drop *)
   169   | End_Detail                     (* WN0509 drop *)
   170 
   171   | Empty_Tac
   172   | Free_Solve
   173 
   174   | Init_Proof of TermC.as_string list * Spec.T
   175   | Model_Problem
   176   | Or_to_List
   177   | Refine_Problem of Problem.id
   178   | Refine_Tacitly of Problem.id
   179 
   180    (* rewrite-tactics can transport a (thmID, thm) to and (!) from the java-front-end
   181      because there all the thms are present with both (thmID, thm)
   182      (where user-views can show both or only one of (thmID, thm)),
   183      and thm is created from ThmID by assoc_thm'' when entering isabisac *)
   184   | Rewrite of ThmC.T
   185   | Rewrite_Inst of Subst.input * ThmC.T
   186   | Rewrite_Set of Rule_Set.id
   187   | Rewrite_Set_Inst of Subst.input * Rule_Set.id
   188 
   189   | Specify_Method of Method.id
   190   | Specify_Problem of Problem.id
   191   | Specify_Theory of ThyC.id
   192   | Subproblem of ThyC.id * Problem.id (* WN0509 drop *)
   193 
   194   | Substitute of Subst.input
   195   | Tac of string               (* WN0509 drop *)
   196   | Take of TermC.as_string | Take_Inst of TermC.as_string
   197 
   198 fun input_to_string ma = case ma of
   199     Init_Proof (ppc, spec)  => 
   200       "Init_Proof "^(pair2str (strs2str ppc, Spec.to_string spec))
   201   | Model_Problem           => "Model_Problem "
   202   | Refine_Tacitly pblID    => "Refine_Tacitly " ^ strs2str pblID 
   203   | Refine_Problem pblID    => "Refine_Problem " ^ strs2str pblID 
   204   | Add_Given cterm'        => "Add_Given " ^ cterm'
   205   | Del_Given cterm'        => "Del_Given " ^ cterm'
   206   | Add_Find cterm'         => "Add_Find " ^ cterm'
   207   | Del_Find cterm'         => "Del_Find " ^ cterm'
   208   | Add_Relation cterm'     => "Add_Relation " ^ cterm'
   209   | Del_Relation cterm'     => "Del_Relation " ^ cterm'
   210 
   211   | Specify_Theory domID    => "Specify_Theory " ^ quote domID
   212   | Specify_Problem pblID   => "Specify_Problem " ^ strs2str pblID
   213   | Specify_Method metID    => "Specify_Method " ^ strs2str metID
   214   | Apply_Method metID      => "Apply_Method " ^ strs2str metID
   215   | Check_Postcond pblID    => "Check_Postcond " ^ strs2str pblID
   216   | Free_Solve              => "Free_Solve"
   217 
   218   | Rewrite_Inst (subs, (id, thm)) =>
   219     "Rewrite_Inst " ^ (pair2str (subs2str subs, spair2str (id, thm |> Thm.prop_of |> UnparseC.term)))
   220   | Rewrite (id, thm) => "Rewrite " ^ spair2str (id, thm |> Thm.prop_of |> UnparseC.term)
   221   | Rewrite_Set_Inst (subs, rls) => 
   222     "Rewrite_Set_Inst " ^ pair2str (subs2str subs, quote rls)
   223   | Rewrite_Set rls         => "Rewrite_Set " ^ quote rls
   224   | Detail_Set rls          => "Detail_Set " ^ quote rls
   225   | Detail_Set_Inst (subs, rls) =>  "Detail_Set_Inst " ^ pair2str (subs2str subs, quote rls)
   226   | End_Detail              => "End_Detail"
   227   | Derive rls'             => "Derive " ^ rls' 
   228   | Calculate op_           => "Calculate " ^ op_
   229   | Substitute sube         => "Substitute " ^ Subst.string_eqs_to_string sube	     
   230   | Apply_Assumption ct's   => "Apply_Assumption " ^ strs2str ct's
   231 
   232   | Take cterm'             => "Take " ^ quote cterm'
   233   | Take_Inst cterm'        => "Take_Inst " ^ quote cterm'
   234   | Subproblem (domID, pblID) => "Subproblem " ^ pair2str (domID, strs2str pblID)
   235   | End_Subproblem          => "End_Subproblem"
   236   | CAScmd cterm'           => "CAScmd " ^ quote cterm'
   237 
   238   | Check_elementwise cterm'=> "Check_elementwise " ^ quote cterm'
   239   | Or_to_List              => "Or_to_List "
   240   | Collect_Trues           => "Collect_Trues"
   241 
   242   | Empty_Tac               => "Empty_Tac"
   243   | Tac string              => "Tac " ^ string
   244   | End_Proof'              => "input End_Proof'"
   245   | _                       => "input_to_string not impl. for ?!";
   246 
   247 fun tac2IDstr ma = case ma of
   248     Model_Problem => "Model_Problem"
   249   | Refine_Tacitly _ => "Refine_Tacitly"
   250   | Refine_Problem _ => "Refine_Problem"
   251   | Add_Given _ => "Add_Given"
   252   | Del_Given _ => "Del_Given"
   253   | Add_Find _ => "Add_Find"
   254   | Del_Find _ => "Del_Find"
   255   | Add_Relation _ => "Add_Relation"
   256   | Del_Relation _ => "Del_Relation"
   257 
   258   | Specify_Theory _ => "Specify_Theory"
   259   | Specify_Problem _ => "Specify_Problem"
   260   | Specify_Method _ => "Specify_Method"
   261   | Apply_Method _ => "Apply_Method"
   262   | Check_Postcond _ => "Check_Postcond"
   263   | Free_Solve => "Free_Solve"
   264 
   265   | Rewrite_Inst _ => "Rewrite_Inst"
   266   | Rewrite _ => "Rewrite"
   267   | Rewrite_Set_Inst _ => "Rewrite_Set_Inst"
   268   | Rewrite_Set _ => "Rewrite_Set"
   269   | Detail_Set _ => "Detail_Set"
   270   | Detail_Set_Inst _ => "Detail_Set_Inst"
   271   | Derive _ => "Derive "
   272   | Calculate _ => "Calculate "
   273   | Substitute _ => "Substitute" 
   274   | Apply_Assumption _ => "Apply_Assumption"
   275 
   276   | Take _ => "Take"
   277   | Take_Inst _ => "Take_Inst"
   278   | Subproblem _ => "Subproblem"
   279   | End_Subproblem => "End_Subproblem"
   280   | CAScmd _ => "CAScmd"
   281 
   282   | Check_elementwise _ => "Check_elementwise"
   283   | Or_to_List => "Or_to_List "
   284   | Collect_Trues => "Collect_Trues"
   285 
   286   | Empty_Tac => "Empty_Tac"
   287   | Tac _ => "Tac "
   288   | End_Proof' => "End_Proof'"
   289   | _ => "input_to_string not impl. for ?!";
   290 
   291 fun is_empty input = case input of Empty_Tac => true | _ => false
   292 
   293 fun eq_tac (Rewrite (id1, _), Rewrite (id2, _)) = id1 = id2
   294   | eq_tac (Rewrite_Inst (_, (id1, _)), Rewrite_Inst (_, (id2, _))) = id1 = id2
   295   | eq_tac (Rewrite_Set id1, Rewrite_Set id2) = id1 = id2
   296   | eq_tac (Rewrite_Set_Inst (_, id1), Rewrite_Set_Inst (_, id2)) = id1 = id2
   297   | eq_tac (Calculate id1, Calculate id2) = id1 = id2
   298   | eq_tac _ = false
   299 
   300 fun is_rewset (Rewrite_Set_Inst _) = true
   301   | is_rewset (Rewrite_Set _) = true 
   302   | is_rewset _ = false;
   303 fun is_rewtac (Rewrite _) = true
   304   | is_rewtac (Rewrite_Inst _) = true
   305   | is_rewtac input = is_rewset input;
   306 
   307 
   308 fun rls_of (Rewrite_Set_Inst (_, rls)) = rls
   309   | rls_of (Rewrite_Set rls) = rls
   310   | rls_of input = error ("rls_of: called with input \"" ^ tac2IDstr input ^ "\"");
   311 
   312 fun rule2tac thy _ (Rule.Eval (opID, _)) = Calculate (assoc_calc thy opID)
   313   | rule2tac _ [] (Rule.Thm thm'') = Rewrite thm''
   314   | rule2tac _ subst (Rule.Thm thm'') = 
   315     Rewrite_Inst (Subst.T_to_input subst, thm'')
   316   | rule2tac _ [] (Rule.Rls_ rls) = Rewrite_Set (Rule_Set.id rls)
   317   | rule2tac _ subst (Rule.Rls_ rls) = 
   318     Rewrite_Set_Inst (Subst.T_to_input subst, (Rule_Set.id rls))
   319   | rule2tac _ _ rule = 
   320     error ("rule2tac: called with \"" ^ Rule.to_string rule ^ "\"");
   321 
   322 (* try if a rewrite-rule is applicable to a given formula; 
   323    in case of rule-sets (recursivley) collect all _atomic_ rewrites *) 
   324 fun try_rew thy ((_, ro) : Rewrite_Ord.rew_ord) erls (subst : subst) f (thm' as Rule.Thm (_, thm)) =
   325     if Auto_Prog.contains_bdv thm
   326     then case Rewrite.rewrite_inst_ thy ro erls false subst thm f of
   327 	    SOME _ => [rule2tac thy subst thm']
   328 	  | NONE => []
   329     else (case Rewrite.rewrite_ thy ro erls false thm f of
   330 	    SOME _ => [rule2tac thy [] thm']
   331 	  | NONE => [])
   332   | try_rew thy _ _ _ f (cal as Rule.Eval c) = 
   333     (case Eval.adhoc_thm thy c f of
   334 	    SOME _ => [rule2tac thy [] cal]
   335     | NONE => [])
   336   | try_rew thy _ _ _ f (cal as Rule.Cal1 c) = 
   337     (case Eval.adhoc_thm thy c f of
   338 	      SOME _ => [rule2tac thy [] cal]
   339       | NONE => [])
   340   | try_rew thy _ _ subst f (Rule.Rls_ rls) = filter_appl_rews thy subst f rls
   341   | try_rew _ _ _ _ _ _ = error "try_rew: uncovered case"
   342 and filter_appl_rews thy subst f (Rule_Def.Repeat {rew_ord = ro, erls, rules, ...}) = 
   343     gen_distinct eq_tac (flat (map (try_rew thy ro erls subst f) rules))
   344   | filter_appl_rews thy subst f (Rule_Set.Sequence {rew_ord = ro, erls, rules,...}) = 
   345     gen_distinct eq_tac (flat (map (try_rew thy ro erls subst f) rules))
   346   | filter_appl_rews _ _ _ (Rule_Set.Rrls _) = []
   347   | filter_appl_rews _ _ _ _ = error "filter_appl_rews: uncovered case"
   348 
   349 (* decide if a tactic is applicable to a given formula; 
   350    in case of Rewrite_Set* go down to _atomic_ rewrite-tactics *)
   351 fun applicable thy _ _ f (Calculate scrID) =
   352     try_rew thy Rewrite_Ord.e_rew_ordX Rule_Set.empty [] f (Rule.Eval (assoc_calc' thy scrID |> snd))
   353   | applicable thy ro erls f (Rewrite thm'') =
   354     try_rew thy (ro, Rewrite_Ord.assoc_rew_ord ro) erls [] f (Rule.Thm thm'')
   355   | applicable thy ro erls f (Rewrite_Inst (subs, thm'')) =
   356     try_rew thy (ro, Rewrite_Ord.assoc_rew_ord ro) erls (Subst.T_from_input thy subs) f (Rule.Thm thm'')
   357 
   358   | applicable thy _ _ f (Rewrite_Set rls') =
   359     filter_appl_rews thy [] f (assoc_rls rls')
   360   | applicable thy _ _ f (Rewrite_Set_Inst (subs, rls')) =
   361     filter_appl_rews thy (Subst.T_from_input thy subs) f (assoc_rls rls')
   362   | applicable _ _ _ _ tac = 
   363     (tracing ("### applicable: not impl. for tac = '" ^ input_to_string tac ^ "'"); []);
   364 
   365 
   366 (** tactics for internal use **)
   367 
   368 (* tactics for for internal use, compare "input" for user at the front-end.
   369   tac_ contains results from check in 'fun applicable_in'.
   370   This is useful for costly results, e.g. from rewriting;
   371   however, these results might be changed by Scripts like
   372       "      eq = (Rewrite_Set ''ansatz_rls'' False) eql;" ^
   373       "      eq = (Rewrite_Set equival_trans False) eq;" ^
   374   TODO.WN120106 ANALOGOUSLY TO Substitute':
   375   So tac_ contains the term t the result was calculated from
   376   in order to compare t with t' possibly changed by "Expr "
   377   and re-calculate result if t<>t'
   378   TODO.WN161219: replace *every* cterm' by term
   379 *)
   380   datatype T =
   381     Add_Find' of TermC.as_string * Model.itm list | Add_Given' of TermC.as_string * Model.itm list 
   382   | Add_Relation' of TermC.as_string * Model.itm list
   383   | Apply_Method' of (* creates the 1st step visible in a (sub-) comprising
   384                       * tactic Apply_Method metID
   385                       * formula term                                        *)
   386       Method.id *  (* key for Know_Store                                     *)
   387       term option *  (* the first formula of Calc.T. TODO: rm option        *)           
   388       Istate_Def.T * (* for the newly started program                       *)
   389       Proof.context  (* for the newly started program                       *)
   390   (*/--- TODO: re-design ? -----------------------------------------------------------------\*)
   391   | Begin_Sequ' | Begin_Trans' of term
   392   | Split_And' of term | Split_Or' of term | Split_Intersect' of term
   393   | Conclude_And' of term | Conclude_Or' of term | Collect_Trues' of term
   394   | End_Sequ' | End_Trans' of Selem.result
   395   | End_Ruleset' of term | End_Intersect' of term | End_Proof''
   396   (*\--- TODO: re-design ? -----------------------------------------------------------------/*)
   397   | CAScmd' of term
   398   | Calculate' of ThyC.id * string * term * (term * ThmC.T)
   399   | Check_Postcond' of Problem.id *
   400     term         (* returnvalue of program in solve *)
   401   | Check_elementwise' of (* DEPRECATED, made idle for Calc.T in df00a2b5c4cc *)
   402     term *       (* (1) the current formula: [x=1,x=...]                      *)
   403     string *     (* (2) the pred from Check_elementwise                       *)
   404     Selem.result (* (3) composed from (1) and (2): {x. pred}                  *)
   405   | Del_Find' of TermC.as_string | Del_Given' of TermC.as_string | Del_Relation' of TermC.as_string
   406 
   407   | Derive' of Rule_Set.T
   408   | Detail_Set' of ThyC.id * bool * Rule_Set.T * term * Selem.result
   409   | Detail_Set_Inst' of ThyC.id * bool * subst * Rule_Set.T * term * Selem.result
   410   | End_Detail' of Selem.result
   411 
   412   | Empty_Tac_
   413   | Free_Solve'
   414 
   415   | Init_Proof' of TermC.as_string list * Spec.T
   416   | Model_Problem' of (* first step in specifying   *)
   417     Problem.id *     (* key into Know_Store           *)
   418     Model.itm list *  (* the 'untouched' pbl        *)
   419     Model.itm list    (* the casually completed met *)
   420   | Or_to_List' of term * term
   421   | Refine_Problem' of Problem.id * (Model.itm list * (bool * term) list)
   422   | Refine_Tacitly' of
   423     Problem.id *     (* input                                                                *)
   424     Problem.id *     (* the refined from applicable_in                                       *)
   425     ThyC.id *      (* from new pbt?! filled in specify                                     *)
   426     Method.id *     (* from new pbt?! filled in specify                                     *)
   427     Model.itm list    (* drop ! 9.03: remains [] for Model_Problem recognizing its activation *)
   428   | Rewrite' of ThyC.id * Rewrite_Ord.rew_ord' * Rule_Set.T * bool * ThmC.T * term * Selem.result
   429   | Rewrite_Inst' of ThyC.id * Rewrite_Ord.rew_ord' * Rule_Set.T * bool * subst * ThmC.T * term * Selem.result
   430   | Rewrite_Set' of ThyC.id * bool * Rule_Set.T * term * Selem.result
   431   | Rewrite_Set_Inst' of ThyC.id * bool * subst * Rule_Set.T * term * Selem.result
   432 
   433   | Specify_Method' of Method.id * Model.ori list * Model.itm list
   434   | Specify_Problem' of Problem.id * 
   435     (bool *                  (* matches	                                  *)
   436       (Model.itm list *      (* ppc	                                      *)
   437         (bool * term) list)) (* preconditions marked true/false           *)
   438   | Specify_Theory' of ThyC.id
   439   | Subproblem' of
   440     Spec.T * 
   441 		(Model.ori list) *       (* filled in associate Subproblem'           *)
   442 		term *                   (* filled -"-, headline of calc-head         *)
   443 		Selem.fmz_ *             (* string list from arguments                *)
   444     Proof.context *          (* for specify-phase                         *)
   445 		term                     (* Subproblem (thyID, pbl) OR cascmd         *)  
   446   | Substitute' of           
   447     Rule_Def.rew_ord_ *          (* for re-calculation                        *)
   448     Rule_Set.T *               (* for re-calculation                        *)
   449     Subst.as_eqs *            (* the 'substitution': terms of type bool    *)
   450     term *                   (* to be substituted into                    *)
   451     term                     (* resulting from the substitution           *)
   452   | Tac_ of theory * string * string * string
   453   | Take' of term
   454 
   455 fun string_of ma = case ma of
   456     Init_Proof' (ppc, spec)  => "Init_Proof' " ^ pair2str (strs2str ppc, Spec.to_string spec)
   457   | Model_Problem' (pblID, _, _) => "Model_Problem' " ^ strs2str pblID
   458   | Refine_Tacitly'(p, prefin, domID, metID, _) => "Refine_Tacitly' (" ^ strs2str p ^ ", " ^
   459     strs2str prefin ^ ", " ^ domID ^ ", " ^ strs2str metID ^ ", pbl-itms)"
   460   | Refine_Problem' _ => "Refine_Problem' (" ^ (*matchs2str ms*)"..." ^ ")"
   461   | Add_Given' _ => "Add_Given' "(*^cterm'*)
   462   | Del_Given' _ => "Del_Given' "(*^cterm'*)
   463   | Add_Find' _ => "Add_Find' "(*^cterm'*)
   464   | Del_Find' _ => "Del_Find' "(*^cterm'*)
   465   | Add_Relation' _ => "Add_Relation' "(*^cterm'*)
   466   | Del_Relation' _ => "Del_Relation' "(*^cterm'*)
   467 
   468   | Specify_Theory' domID => "Specify_Theory' " ^ quote domID
   469   | Specify_Problem' (pI, (ok, _)) =>  "Specify_Problem' " ^ 
   470     spair2str (strs2str pI, spair2str (bool2str ok, spair2str ("itms2str_ itms", "items2str pre")))
   471   | Specify_Method' (pI, oris, _) => "Specify_Method' (" ^ 
   472     Method.id_to_string pI ^ ", " ^ Model.oris2str oris ^ ", )"
   473 
   474   | Apply_Method' (metID, _, _, _) => "Apply_Method' " ^ strs2str metID
   475   | Check_Postcond' (pblID, scval) => "Check_Postcond' " ^
   476       (spair2str (strs2str pblID, UnparseC.term scval))
   477 
   478   | Free_Solve' => "Free_Solve'"
   479 
   480   | Rewrite_Inst' (*subs,thm'*) _ => "Rewrite_Inst' "(*^(pair2str (subs2str subs, spair2str thm'))*)
   481   | Rewrite' _(*thm'*) => "Rewrite' "(*^(spair2str thm')*)
   482   | Rewrite_Set_Inst' _(*subs,thm'*) => "Rewrite_Set_Inst' "(*^(pair2str (subs2str subs, quote rls))*)
   483   | Rewrite_Set' (thy', pasm, rls', f, (f', asm)) => "Rewrite_Set' (" ^ thy' ^ "," ^ bool2str pasm ^
   484     "," ^ Rule_Set.id rls' ^ "," ^ UnparseC.term f ^ ",(" ^ UnparseC.term f' ^ "," ^ UnparseC.terms asm ^ "))"
   485   | End_Detail' _ => "End_Detail' xxx"
   486   | Detail_Set' _ => "Detail_Set' xxx"
   487   | Detail_Set_Inst' _ => "Detail_Set_Inst' xxx"
   488 
   489   | Derive' rls => "Derive' " ^ Rule_Set.id rls
   490   | Calculate'  _ => "Calculate' "
   491   | Substitute' _ => "Substitute' "(*^(subs2str subs)*)    
   492 
   493   | Take' _(*cterm'*) => "Take' "(*^(quote cterm'	)*)
   494   | Subproblem' _(*(spec, oris, _, _, _, pbl_form)*) => 
   495     "Subproblem' "(*^(pair2str (domID, strs2str ,))*)
   496   | CAScmd' _(*cterm'*) => "CAScmd' "(*^(quote cterm')*)
   497 
   498   | Empty_Tac_ => "Empty_Tac_"
   499   | Tac_ (_, form, id, result) => "Tac_ (thy," ^ form ^ "," ^ id ^ "," ^ result ^ ")"
   500   | _  => "string_of not impl. for arg";
   501 
   502 fun input_from_T (Refine_Tacitly' (pI, _, _, _, _)) = Refine_Tacitly pI
   503   | input_from_T (Model_Problem' (_, _, _)) = Model_Problem
   504   | input_from_T (Add_Given' (t, _)) = Add_Given t
   505   | input_from_T (Add_Find' (t, _)) = Add_Find t
   506   | input_from_T (Add_Relation' (t, _)) = Add_Relation t
   507  
   508   | input_from_T (Specify_Theory' dI) = Specify_Theory dI
   509   | input_from_T (Specify_Problem' (dI, _)) = Specify_Problem dI
   510   | input_from_T (Specify_Method' (dI, _, _)) = Specify_Method dI
   511   
   512   | input_from_T (Rewrite' (_, _, _, _, thm, _, _)) = Rewrite thm
   513   | input_from_T (Rewrite_Inst' (_, _, _, _, sub, thm, _, _)) = Rewrite_Inst (Subst.T_to_input sub, thm)
   514 
   515   | input_from_T (Rewrite_Set' (_, _, rls, _, _)) = Rewrite_Set (Rule_Set.id rls)
   516   | input_from_T (Detail_Set' (_, _, rls, _, _)) = Detail_Set (Rule_Set.id rls)
   517 
   518   | input_from_T (Rewrite_Set_Inst' (_, _, sub, rls, _, _)) = 
   519     Rewrite_Set_Inst (Subst.T_to_input sub, Rule_Set.id rls)
   520   | input_from_T (Detail_Set_Inst' (_, _, sub, rls, _, _)) = 
   521     Detail_Set_Inst (Subst.T_to_input sub, Rule_Set.id rls)
   522 
   523   | input_from_T (Calculate' (_, op_, _, _)) = Calculate (op_)
   524   | input_from_T (Check_elementwise' (_, pred, _)) = Check_elementwise pred
   525 
   526   | input_from_T (Or_to_List' _) = Or_to_List
   527   | input_from_T (Take' term) = Take (UnparseC.term term)
   528   | input_from_T (Substitute' (_, _, subte, _, _)) = Substitute (Subst.eqs_to_input subte) 
   529   | input_from_T (Tac_ (_, _, id, _)) = Tac id
   530 
   531   | input_from_T (Subproblem' ((domID, pblID, _), _, _, _,_ ,_)) = Subproblem (domID, pblID)
   532   | input_from_T (Check_Postcond' (pblID, _)) = Check_Postcond pblID
   533   | input_from_T Empty_Tac_ = Empty_Tac
   534   | input_from_T m = raise ERROR (": not impl. for "^(string_of m));
   535 
   536 fun res (Rewrite_Inst' (_ , _, _, _, _, _, _, res)) = res
   537   | res (Rewrite' (_, _, _, _, _, _, res)) = res
   538   | res (Rewrite_Set_Inst' (_, _, _, _, _, res)) = res
   539   | res (Rewrite_Set' (_, _, _, _, res)) = res
   540   | res (Calculate' (_, _, _, (t, _))) = (t, [])
   541   | res (Check_elementwise' (_, _, res)) = res
   542   | res (Subproblem' (_, _, _, _, _, t)) = (t, [])
   543   | res (Take' t) = (t, [])
   544   | res (Substitute' (_, _, _, _, t)) = (t, [])
   545   | res (Or_to_List' (_,  t)) = (t, [])
   546   | res m = raise ERROR ("result: not impl.for " ^ string_of m)
   547 
   548 (*fun result m = (fst o res) m; TODO*)
   549 fun result tac = (fst o res) tac;
   550 fun creates_assms tac = (snd o res) tac;
   551 
   552 fun insert_assumptions tac ctxt  = ContextC.insert_assumptions (creates_assms tac) ctxt
   553 
   554 fun for_specify (Init_Proof _) = true
   555   | for_specify Model_Problem  = true
   556   | for_specify (Refine_Tacitly _) = true
   557   | for_specify (Refine_Problem _) = true
   558   | for_specify (Add_Given _) = true
   559   | for_specify (Del_Given _) = true
   560   | for_specify (Add_Find _) = true
   561   | for_specify (Del_Find _) = true
   562   | for_specify (Add_Relation _) = true
   563   | for_specify (Del_Relation _) = true
   564   | for_specify (Specify_Theory _) = true
   565   | for_specify (Specify_Problem _) = true
   566   | for_specify (Specify_Method _) = true
   567   | for_specify _ = false
   568 fun for_specify' (Init_Proof' _) = true
   569   | for_specify' (Model_Problem' _) = true
   570   | for_specify' (Refine_Tacitly' _) = true
   571   | for_specify' (Refine_Problem' _) = true
   572   | for_specify' (Add_Given' _) = true
   573   | for_specify' (Del_Given' _) = true
   574   | for_specify' (Add_Find' _) = true
   575   | for_specify' (Del_Find' _) = true
   576   | for_specify' (Add_Relation' _) = true
   577   | for_specify' (Del_Relation' _) = true
   578   | for_specify' (Specify_Theory' _) = true
   579   | for_specify' (Specify_Problem' _) = true
   580   | for_specify' (Specify_Method' _) = true
   581   | for_specify' _ = false
   582 
   583 (**)end(**)