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