src/Tools/isac/MathEngBasic/tactic.sml
author Walther Neuper <walther.neuper@jku.at>
Sat, 16 Nov 2019 17:13:52 +0100
changeset 59704 178869f0f4ba
parent 59702 501a4ae08275
child 59728 f47a69ee4504
permissions -rw-r--r--
lucin: consolidate Tactic, 1st
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
wneuper@59304
     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_Asm|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
wneuper@59571
    12
  datatype T =
wneuper@59416
    13
    Add_Find' of Rule.cterm' * Model.itm list | Add_Given' of Rule.cterm' * Model.itm list 
wneuper@59416
    14
  | Add_Relation' of Rule.cterm' * Model.itm list
wneuper@59302
    15
  | Apply_Assumption' of term list * term
wneuper@59572
    16
  | Apply_Method' of Celem.metID * term option * Istate.T * Proof.context
wneuper@59302
    17
wneuper@59302
    18
  | Begin_Sequ' | Begin_Trans' of term
wneuper@59302
    19
  | Split_And' of term | Split_Or' of term | Split_Intersect' of term
wneuper@59302
    20
  | Conclude_And' of term | Conclude_Or' of term | Collect_Trues' of term
wneuper@59302
    21
  | End_Sequ' | End_Trans' of Selem.result
wneuper@59302
    22
  | End_Ruleset' of term | End_Subproblem' of term | End_Intersect' of term | End_Proof''
wneuper@59302
    23
wneuper@59302
    24
  | CAScmd' of term
wneuper@59416
    25
  | Calculate' of Rule.theory' * string * term * (term * Celem.thm')
wneuper@59405
    26
  | Check_Postcond' of Celem.pblID * Selem.result
wneuper@59416
    27
  | Check_elementwise' of term * Rule.cterm' * Selem.result
wneuper@59416
    28
  | Del_Find' of Rule.cterm' | Del_Given' of Rule.cterm' | Del_Relation' of Rule.cterm'
wneuper@59302
    29
wneuper@59416
    30
  | Derive' of Rule.rls
wneuper@59416
    31
  | Detail_Set' of Rule.theory' * bool * Rule.rls * term * Selem.result
wneuper@59416
    32
  | Detail_Set_Inst' of Rule.theory' * bool * Rule.subst * Rule.rls * term * Selem.result
wneuper@59302
    33
  | End_Detail' of Selem.result
wneuper@59302
    34
wneuper@59302
    35
  | Empty_Tac_
wneuper@59302
    36
  | Free_Solve'
wneuper@59302
    37
wneuper@59416
    38
  | Init_Proof' of Rule.cterm' list * Celem.spec
wneuper@59405
    39
  | Model_Problem' of Celem.pblID * Model.itm list * Model.itm list
wneuper@59302
    40
  | Or_to_List' of term * term
wneuper@59405
    41
  | Refine_Problem' of Celem.pblID * (Model.itm list * (bool * term) list)
wneuper@59416
    42
  | Refine_Tacitly' of Celem.pblID * Celem.pblID * Rule.domID * Celem.metID * Model.itm list
wneuper@59302
    43
wneuper@59416
    44
  | Rewrite' of Rule.theory' * Rule.rew_ord' * Rule.rls * bool * Celem.thm'' * term * Selem.result
wneuper@59416
    45
  | Rewrite_Asm' of Rule.theory' * Rule.rew_ord' * Rule.rls * bool * Celem.thm'' * term * Selem.result
wneuper@59416
    46
  | Rewrite_Inst' of Rule.theory' * Rule.rew_ord' * Rule.rls * bool * Rule.subst * Celem.thm'' * term * Selem.result
wneuper@59416
    47
  | Rewrite_Set' of Rule.theory' * bool * Rule.rls * term * Selem.result
wneuper@59416
    48
  | Rewrite_Set_Inst' of Rule.theory' * bool * Rule.subst * Rule.rls * term * Selem.result
wneuper@59302
    49
wneuper@59405
    50
  | Specify_Method' of Celem.metID * Model.ori list * Model.itm list
wneuper@59405
    51
  | Specify_Problem' of Celem.pblID * (bool * (Model.itm list * (bool * term) list))
wneuper@59416
    52
  | Specify_Theory' of Rule.domID
wneuper@59405
    53
  | Subproblem' of Celem.spec * Model.ori list * term * Selem.fmz_ * Proof.context * term
wneuper@59416
    54
  | Substitute' of Rule.rew_ord_ * Rule.rls * Selem.subte * term * term
wneuper@59302
    55
  | Tac_ of theory * string * string * string
wneuper@59302
    56
  | Take' of term | Take_Inst' of term
wneuper@59571
    57
  val tac_2str : T -> string
wneuper@59302
    58
wneuper@59571
    59
  datatype input =
wneuper@59416
    60
    Add_Find of Rule.cterm' | Add_Given of Rule.cterm' | Add_Relation of Rule.cterm'
wneuper@59416
    61
  | Apply_Assumption of Rule.cterm' list
wneuper@59405
    62
  | Apply_Method of Celem.metID
wneuper@59302
    63
  (*/--- TODO: re-design ? -----------------------------------------------------------------\*)
wneuper@59302
    64
  | Begin_Sequ | Begin_Trans
wneuper@59302
    65
  | Split_And | Split_Or | Split_Intersect
wneuper@59302
    66
  | Conclude_And | Conclude_Or | Collect_Trues
wneuper@59302
    67
  | End_Sequ | End_Trans
wneuper@59302
    68
  | End_Ruleset | End_Subproblem | End_Intersect | End_Proof'
wneuper@59302
    69
  (*\--- TODO: re-design ? -----------------------------------------------------------------/*)
wneuper@59416
    70
  | CAScmd of Rule.cterm'
wneuper@59302
    71
  | Calculate of string
wneuper@59405
    72
  | Check_Postcond of Celem.pblID
wneuper@59416
    73
  | Check_elementwise of Rule.cterm'
wneuper@59416
    74
  | Del_Find of Rule.cterm' | Del_Given of Rule.cterm' | Del_Relation of Rule.cterm'
wneuper@59302
    75
wneuper@59416
    76
  | Derive of Rule.rls'
wneuper@59416
    77
  | Detail_Set of Rule.rls'
wneuper@59416
    78
  | Detail_Set_Inst of Selem.subs * Rule.rls'
wneuper@59302
    79
  | End_Detail
wneuper@59302
    80
wneuper@59302
    81
  | Empty_Tac
wneuper@59302
    82
  | Free_Solve
wneuper@59302
    83
wneuper@59416
    84
  | Init_Proof of Rule.cterm' list * Celem.spec
wneuper@59302
    85
  | Model_Problem
wneuper@59302
    86
  | Or_to_List
wneuper@59405
    87
  | Refine_Problem of Celem.pblID
wneuper@59405
    88
  | Refine_Tacitly of Celem.pblID
wneuper@59302
    89
wneuper@59405
    90
  | Rewrite of Celem.thm''
wneuper@59405
    91
  | Rewrite_Asm of Celem.thm''
wneuper@59405
    92
  | Rewrite_Inst of Selem.subs * Celem.thm''
wneuper@59416
    93
  | Rewrite_Set of Rule.rls'
wneuper@59416
    94
  | Rewrite_Set_Inst of Selem.subs * Rule.rls'
wneuper@59302
    95
wneuper@59405
    96
  | Specify_Method of Celem.metID
wneuper@59405
    97
  | Specify_Problem of Celem.pblID
wneuper@59416
    98
  | Specify_Theory of Rule.domID
wneuper@59416
    99
  | Subproblem of Rule.domID * Celem.pblID
wneuper@59302
   100
wneuper@59302
   101
  | Substitute of Selem.sube
wneuper@59302
   102
  | Tac of string
wneuper@59416
   103
  | Take of Rule.cterm' | Take_Inst of Rule.cterm'
wneuper@59571
   104
  val tac2str : input -> string
wneuper@59302
   105
wneuper@59571
   106
  val eq_tac : input * input -> bool                                              (* for script.sml *)
wneuper@59571
   107
  val is_empty_tac : input -> bool                                              (* also for tests *)
wneuper@59571
   108
  val is_rewtac : input -> bool                                              (* for interface.sml *)
wneuper@59571
   109
  val is_rewset : input -> bool                                             (* for mathengine.sml *)
wneuper@59571
   110
  val rls_of : input -> Rule.rls'                                               (* for solve.sml *)
wneuper@59571
   111
  val tac2IDstr : input -> string
wneuper@59571
   112
  val rule2tac : theory -> (term * term) list ->  Rule.rule -> input         (* for rewtools.sml *)
walther@59704
   113
  val input_from_T : T -> input
wneuper@59310
   114
(* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
wneuper@59310
   115
  (* NONE *)
walther@59702
   116
(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
wneuper@59310
   117
  (* NONE *)
walther@59702
   118
( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
wneuper@59298
   119
wneuper@59310
   120
(*----- unused code, kept as hints to design ideas ---------------------------------------------*)
wneuper@59310
   121
  (* NONE *)
wneuper@59298
   122
end
wneuper@59298
   123
wneuper@59571
   124
structure Tactic(**): TACTIC(**) =
wneuper@59298
   125
struct
wneuper@59298
   126
wneuper@59302
   127
(* tactics for user at front-end.
wneuper@59571
   128
   input propagates the construction of the calc-tree;
wneuper@59302
   129
   there are
wneuper@59302
   130
   (a) 'specsteps' for the specify-phase, and others for the solve-phase
wneuper@59302
   131
   (b) those of the solve-phase are 'initac's and others;
wneuper@59302
   132
       initacs start with a formula different from the preceding formula.
wneuper@59302
   133
   see 'type tac_' for the internal representation of tactics
wneuper@59302
   134
*)
wneuper@59571
   135
datatype input =
wneuper@59416
   136
    Add_Find of Rule.cterm' | Add_Given of Rule.cterm' | Add_Relation of Rule.cterm'
wneuper@59416
   137
  | Apply_Assumption of Rule.cterm' list
wneuper@59405
   138
  | Apply_Method of Celem.metID
wneuper@59302
   139
    (* creates an "istate" in PblObj.env; in case of "init_form" 
wneuper@59302
   140
      creates a formula at ((lev_on o lev_dn) p, Frm) and in this "ppobj.loc"
wneuper@59302
   141
      a "SOME istate" at fst of "loc".
wneuper@59302
   142
      As each step (in the solve-phase) has a resulting formula (at the front-end)
wneuper@59302
   143
      Apply_Method also does the 1st step in the script (an "initac") if there is no "init_form" *)  
wneuper@59302
   144
  (*/--- TODO: re-design ? -----------------------------------------------------------------\*)
wneuper@59302
   145
  | Begin_Sequ | Begin_Trans
wneuper@59302
   146
  | Split_And | Split_Or | Split_Intersect
wneuper@59302
   147
  | Conclude_And | Conclude_Or | Collect_Trues
wneuper@59302
   148
  | End_Sequ | End_Trans
wneuper@59302
   149
  | End_Ruleset | End_Subproblem (* WN0509 drop *) | End_Intersect | End_Proof'
wneuper@59302
   150
  (*\--- TODO: re-design ? -----------------------------------------------------------------/*)
wneuper@59416
   151
  | CAScmd of Rule.cterm'
wneuper@59302
   152
  | Calculate of string
wneuper@59405
   153
  | Check_Postcond of Celem.pblID
wneuper@59416
   154
  | Check_elementwise of Rule.cterm'
wneuper@59416
   155
  | Del_Find of Rule.cterm' | Del_Given of Rule.cterm' | Del_Relation of Rule.cterm'
wneuper@59302
   156
wneuper@59416
   157
  | Derive of Rule.rls'                 (* WN0509 drop *)
wneuper@59416
   158
  | Detail_Set of Rule.rls'             (* WN0509 drop *)
wneuper@59416
   159
  | Detail_Set_Inst of Selem.subs * Rule.rls' (* WN0509 drop *)
wneuper@59302
   160
  | End_Detail                     (* WN0509 drop *)
wneuper@59302
   161
wneuper@59302
   162
  | Empty_Tac
wneuper@59302
   163
  | Free_Solve
wneuper@59302
   164
wneuper@59416
   165
  | Init_Proof of Rule.cterm' list * Celem.spec
wneuper@59302
   166
  | Model_Problem
wneuper@59302
   167
  | Or_to_List
wneuper@59405
   168
  | Refine_Problem of Celem.pblID
wneuper@59405
   169
  | Refine_Tacitly of Celem.pblID
wneuper@59302
   170
wneuper@59302
   171
   (* rewrite-tactics can transport a (thmID, thm) to and (!) from the java-front-end
wneuper@59302
   172
     because there all the thms are present with both (thmID, thm)
wneuper@59302
   173
     (where user-views can show both or only one of (thmID, thm)),
wneuper@59302
   174
     and thm is created from ThmID by assoc_thm'' when entering isabisac *)
wneuper@59405
   175
  | Rewrite of Celem.thm''
wneuper@59405
   176
  | Rewrite_Asm of Celem.thm''
wneuper@59405
   177
  | Rewrite_Inst of Selem.subs * Celem.thm''
wneuper@59416
   178
  | Rewrite_Set of Rule.rls'
wneuper@59416
   179
  | Rewrite_Set_Inst of Selem.subs * Rule.rls'
wneuper@59302
   180
wneuper@59405
   181
  | Specify_Method of Celem.metID
wneuper@59405
   182
  | Specify_Problem of Celem.pblID
wneuper@59416
   183
  | Specify_Theory of Rule.domID
wneuper@59416
   184
  | Subproblem of Rule.domID * Celem.pblID (* WN0509 drop *)
wneuper@59302
   185
wneuper@59302
   186
  | Substitute of Selem.sube
wneuper@59302
   187
  | Tac of string               (* WN0509 drop *)
wneuper@59416
   188
  | Take of Rule.cterm' | Take_Inst of Rule.cterm'
wneuper@59302
   189
wneuper@59302
   190
fun tac2str ma = case ma of
wneuper@59302
   191
    Init_Proof (ppc, spec)  => 
wneuper@59405
   192
      "Init_Proof "^(pair2str (strs2str ppc, Celem.spec2str spec))
wneuper@59302
   193
  | Model_Problem           => "Model_Problem "
wneuper@59302
   194
  | Refine_Tacitly pblID    => "Refine_Tacitly " ^ strs2str pblID 
wneuper@59302
   195
  | Refine_Problem pblID    => "Refine_Problem " ^ strs2str pblID 
wneuper@59302
   196
  | Add_Given cterm'        => "Add_Given " ^ cterm'
wneuper@59302
   197
  | Del_Given cterm'        => "Del_Given " ^ cterm'
wneuper@59302
   198
  | Add_Find cterm'         => "Add_Find " ^ cterm'
wneuper@59302
   199
  | Del_Find cterm'         => "Del_Find " ^ cterm'
wneuper@59302
   200
  | Add_Relation cterm'     => "Add_Relation " ^ cterm'
wneuper@59302
   201
  | Del_Relation cterm'     => "Del_Relation " ^ cterm'
wneuper@59302
   202
wneuper@59302
   203
  | Specify_Theory domID    => "Specify_Theory " ^ quote domID
wneuper@59302
   204
  | Specify_Problem pblID   => "Specify_Problem " ^ strs2str pblID
wneuper@59302
   205
  | Specify_Method metID    => "Specify_Method " ^ strs2str metID
wneuper@59302
   206
  | Apply_Method metID      => "Apply_Method " ^ strs2str metID
wneuper@59302
   207
  | Check_Postcond pblID    => "Check_Postcond " ^ strs2str pblID
wneuper@59302
   208
  | Free_Solve              => "Free_Solve"
wneuper@59302
   209
wneuper@59302
   210
  | Rewrite_Inst (subs, (id, thm)) =>
wneuper@59416
   211
    "Rewrite_Inst " ^ (pair2str (subs2str subs, spair2str (id, thm |> Thm.prop_of |> Rule.term2str)))
wneuper@59416
   212
  | Rewrite (id, thm) => "Rewrite " ^ spair2str (id, thm |> Thm.prop_of |> Rule.term2str)
wneuper@59416
   213
  | Rewrite_Asm (id, thm) => "Rewrite_Asm " ^ spair2str (id, thm |> Thm.prop_of |> Rule.term2str)
wneuper@59302
   214
  | Rewrite_Set_Inst (subs, rls) => 
wneuper@59302
   215
    "Rewrite_Set_Inst " ^ pair2str (subs2str subs, quote rls)
wneuper@59302
   216
  | Rewrite_Set rls         => "Rewrite_Set " ^ quote rls
wneuper@59302
   217
  | Detail_Set rls          => "Detail_Set " ^ quote rls
wneuper@59302
   218
  | Detail_Set_Inst (subs, rls) =>  "Detail_Set_Inst " ^ pair2str (subs2str subs, quote rls)
wneuper@59302
   219
  | End_Detail              => "End_Detail"
wneuper@59302
   220
  | Derive rls'             => "Derive " ^ rls' 
wneuper@59302
   221
  | Calculate op_           => "Calculate " ^ op_ 
wneuper@59302
   222
  | Substitute sube         => "Substitute " ^ Selem.sube2str sube	     
wneuper@59302
   223
  | Apply_Assumption ct's   => "Apply_Assumption " ^ strs2str ct's
wneuper@59302
   224
wneuper@59302
   225
  | Take cterm'             => "Take " ^ quote cterm'
wneuper@59302
   226
  | Take_Inst cterm'        => "Take_Inst " ^ quote cterm'
wneuper@59302
   227
  | Subproblem (domID, pblID) => "Subproblem " ^ pair2str (domID, strs2str pblID)
wneuper@59302
   228
  | End_Subproblem          => "End_Subproblem"
wneuper@59302
   229
  | CAScmd cterm'           => "CAScmd " ^ quote cterm'
wneuper@59302
   230
wneuper@59302
   231
  | Check_elementwise cterm'=> "Check_elementwise " ^ quote cterm'
wneuper@59302
   232
  | Or_to_List              => "Or_to_List "
wneuper@59302
   233
  | Collect_Trues           => "Collect_Trues"
wneuper@59302
   234
wneuper@59302
   235
  | Empty_Tac               => "Empty_Tac"
wneuper@59302
   236
  | Tac string              => "Tac " ^ string
wneuper@59571
   237
  | End_Proof'              => "input End_Proof'"
wneuper@59302
   238
  | _                       => "tac2str not impl. for ?!";
wneuper@59302
   239
wneuper@59571
   240
fun is_empty_tac input = case input of Empty_Tac => true | _ => false
wneuper@59302
   241
wneuper@59302
   242
fun eq_tac (Rewrite (id1, _), Rewrite (id2, _)) = id1 = id2
wneuper@59302
   243
  | eq_tac (Rewrite_Inst (_, (id1, _)), Rewrite_Inst (_, (id2, _))) = id1 = id2
wneuper@59302
   244
  | eq_tac (Rewrite_Set id1, Rewrite_Set id2) = id1 = id2
wneuper@59302
   245
  | eq_tac (Rewrite_Set_Inst (_, id1), Rewrite_Set_Inst (_, id2)) = id1 = id2
wneuper@59302
   246
  | eq_tac (Calculate id1, Calculate id2) = id1 = id2
wneuper@59302
   247
  | eq_tac _ = false
wneuper@59302
   248
wneuper@59302
   249
fun is_rewset (Rewrite_Set_Inst _) = true
wneuper@59302
   250
  | is_rewset (Rewrite_Set _) = true 
wneuper@59302
   251
  | is_rewset _ = false;
wneuper@59302
   252
fun is_rewtac (Rewrite _) = true
wneuper@59302
   253
  | is_rewtac (Rewrite_Inst _) = true
wneuper@59302
   254
  | is_rewtac (Rewrite_Asm _) = true
wneuper@59571
   255
  | is_rewtac input = is_rewset input;
wneuper@59302
   256
wneuper@59302
   257
fun tac2IDstr ma = case ma of
wneuper@59302
   258
    Model_Problem => "Model_Problem"
wneuper@59302
   259
  | Refine_Tacitly _ => "Refine_Tacitly"
wneuper@59302
   260
  | Refine_Problem _ => "Refine_Problem"
wneuper@59302
   261
  | Add_Given _ => "Add_Given"
wneuper@59302
   262
  | Del_Given _ => "Del_Given"
wneuper@59302
   263
  | Add_Find _ => "Add_Find"
wneuper@59302
   264
  | Del_Find _ => "Del_Find"
wneuper@59302
   265
  | Add_Relation _ => "Add_Relation"
wneuper@59302
   266
  | Del_Relation _ => "Del_Relation"
wneuper@59302
   267
wneuper@59302
   268
  | Specify_Theory _ => "Specify_Theory"
wneuper@59302
   269
  | Specify_Problem _ => "Specify_Problem"
wneuper@59302
   270
  | Specify_Method _ => "Specify_Method"
wneuper@59302
   271
  | Apply_Method _ => "Apply_Method"
wneuper@59302
   272
  | Check_Postcond _ => "Check_Postcond"
wneuper@59302
   273
  | Free_Solve => "Free_Solve"
wneuper@59302
   274
wneuper@59302
   275
  | Rewrite_Inst _ => "Rewrite_Inst"
wneuper@59302
   276
  | Rewrite _ => "Rewrite"
wneuper@59302
   277
  | Rewrite_Asm _ => "Rewrite_Asm"
wneuper@59302
   278
  | Rewrite_Set_Inst _ => "Rewrite_Set_Inst"
wneuper@59302
   279
  | Rewrite_Set _ => "Rewrite_Set"
wneuper@59302
   280
  | Detail_Set _ => "Detail_Set"
wneuper@59302
   281
  | Detail_Set_Inst _ => "Detail_Set_Inst"
wneuper@59302
   282
  | Derive _ => "Derive "
wneuper@59302
   283
  | Calculate _ => "Calculate "
wneuper@59302
   284
  | Substitute _ => "Substitute" 
wneuper@59302
   285
  | Apply_Assumption _ => "Apply_Assumption"
wneuper@59302
   286
wneuper@59302
   287
  | Take _ => "Take"
wneuper@59302
   288
  | Take_Inst _ => "Take_Inst"
wneuper@59302
   289
  | Subproblem _ => "Subproblem"
wneuper@59302
   290
  | End_Subproblem => "End_Subproblem"
wneuper@59302
   291
  | CAScmd _ => "CAScmd"
wneuper@59302
   292
wneuper@59302
   293
  | Check_elementwise _ => "Check_elementwise"
wneuper@59302
   294
  | Or_to_List => "Or_to_List "
wneuper@59302
   295
  | Collect_Trues => "Collect_Trues"
wneuper@59302
   296
wneuper@59302
   297
  | Empty_Tac => "Empty_Tac"
wneuper@59302
   298
  | Tac _ => "Tac "
wneuper@59302
   299
  | End_Proof' => "End_Proof'"
wneuper@59302
   300
  | _ => "tac2str not impl. for ?!";
wneuper@59302
   301
wneuper@59302
   302
fun rls_of (Rewrite_Set_Inst (_, rls)) = rls
wneuper@59302
   303
  | rls_of (Rewrite_Set rls) = rls
wneuper@59571
   304
  | rls_of input = error ("rls_of: called with input \"" ^ tac2IDstr input ^ "\"");
wneuper@59302
   305
wneuper@59416
   306
fun rule2tac thy _ (Rule.Calc (opID, _)) = Calculate (assoc_calc thy opID)
wneuper@59416
   307
  | rule2tac _ [] (Rule.Thm thm'') = Rewrite thm''
wneuper@59416
   308
  | rule2tac _ subst (Rule.Thm thm'') = 
wneuper@59302
   309
    Rewrite_Inst (Selem.subst2subs subst, thm'')
wneuper@59416
   310
  | rule2tac _ [] (Rule.Rls_ rls) = Rewrite_Set (Rule.id_rls rls)
wneuper@59416
   311
  | rule2tac _ subst (Rule.Rls_ rls) = 
wneuper@59416
   312
    Rewrite_Set_Inst (Selem.subst2subs subst, (Rule.id_rls rls))
wneuper@59302
   313
  | rule2tac _ _ rule = 
wneuper@59416
   314
    error ("rule2tac: called with \"" ^ Rule.rule2str rule ^ "\"");
wneuper@59302
   315
wneuper@59571
   316
(* tactics for for internal use, compare "input" for user at the front-end.
wneuper@59302
   317
  tac_ contains results from check in 'fun applicable_in'.
wneuper@59302
   318
  This is useful for costly results, e.g. from rewriting;
wneuper@59302
   319
  however, these results might be changed by Scripts like
wneuper@59499
   320
      "      eq = (Rewrite_Set ''ansatz_rls'' False) eql;" ^
wneuper@59302
   321
      "      eq = (Rewrite_Set equival_trans False) eq;" ^
wneuper@59302
   322
  TODO.WN120106 ANALOGOUSLY TO Substitute':
wneuper@59302
   323
  So tac_ contains the term t the result was calculated from
wneuper@59302
   324
  in order to compare t with t' possibly changed by "Expr "
wneuper@59302
   325
  and re-calculate result if t<>t'
wneuper@59302
   326
  TODO.WN161219: replace *every* cterm' by term
wneuper@59302
   327
*)
wneuper@59571
   328
  datatype T =
wneuper@59416
   329
    Add_Find' of Rule.cterm' * Model.itm list | Add_Given' of Rule.cterm' * Model.itm list 
wneuper@59416
   330
  | Add_Relation' of Rule.cterm' * Model.itm list
wneuper@59302
   331
  | Apply_Assumption' of term list * term
wneuper@59572
   332
  | Apply_Method' of Celem.metID * term option * Istate.T * Proof.context
wneuper@59302
   333
  (*/--- TODO: re-design ? -----------------------------------------------------------------\*)
wneuper@59302
   334
  | Begin_Sequ' | Begin_Trans' of term
wneuper@59302
   335
  | Split_And' of term | Split_Or' of term | Split_Intersect' of term
wneuper@59302
   336
  | Conclude_And' of term | Conclude_Or' of term | Collect_Trues' of term
wneuper@59302
   337
  | End_Sequ' | End_Trans' of Selem.result
wneuper@59302
   338
  | End_Ruleset' of term | End_Subproblem' of term | End_Intersect' of term | End_Proof''
wneuper@59302
   339
  (*\--- TODO: re-design ? -----------------------------------------------------------------/*)
wneuper@59302
   340
  | CAScmd' of term
wneuper@59416
   341
  | Calculate' of Rule.theory' * string * term * (term * Celem.thm')
wneuper@59405
   342
  | Check_Postcond' of Celem.pblID *
wneuper@59302
   343
    Selem.result (* returnvalue of script in solve *)
wneuper@59302
   344
  | Check_elementwise' of (*special case:*)
wneuper@59302
   345
    term *       (* (1) the current formula: [x=1,x=...]     *)
wneuper@59302
   346
    string *     (* (2) the pred from Check_elementwise      *)
wneuper@59302
   347
    Selem.result (* (3) composed from (1) and (2): {x. pred} *)
wneuper@59416
   348
  | Del_Find' of Rule.cterm' | Del_Given' of Rule.cterm' | Del_Relation' of Rule.cterm'
wneuper@59302
   349
wneuper@59416
   350
  | Derive' of Rule.rls
wneuper@59416
   351
  | Detail_Set' of Rule.theory' * bool * Rule.rls * term * Selem.result
wneuper@59416
   352
  | Detail_Set_Inst' of Rule.theory' * bool * Rule.subst * Rule.rls * term * Selem.result
wneuper@59302
   353
  | End_Detail' of Selem.result
wneuper@59302
   354
wneuper@59302
   355
  | Empty_Tac_
wneuper@59302
   356
  | Free_Solve'
wneuper@59302
   357
wneuper@59416
   358
  | Init_Proof' of Rule.cterm' list * Celem.spec
wneuper@59405
   359
  | Model_Problem' of Celem.pblID * 
wneuper@59316
   360
    Model.itm list *  (* the 'untouched' pbl        *)
wneuper@59316
   361
    Model.itm list    (* the casually completed met *)
wneuper@59302
   362
  | Or_to_List' of term * term
wneuper@59405
   363
  | Refine_Problem' of Celem.pblID * (Model.itm list * (bool * term) list)
wneuper@59302
   364
  | Refine_Tacitly' of
wneuper@59405
   365
    Celem.pblID *     (* input*)
wneuper@59405
   366
    Celem.pblID *     (* the refined from applicable_in                                       *)
wneuper@59416
   367
    Rule.domID *     (* from new pbt?! filled in specify                                     *)
wneuper@59405
   368
    Celem.metID *     (* from new pbt?! filled in specify                                     *)
wneuper@59316
   369
    Model.itm list    (* drop ! 9.03: remains [] for Model_Problem recognizing its activation *)
wneuper@59416
   370
  | Rewrite' of Rule.theory' * Rule.rew_ord' * Rule.rls * bool * Celem.thm'' * term * Selem.result
wneuper@59416
   371
  | Rewrite_Asm' of Rule.theory' * Rule.rew_ord' * Rule.rls * bool * Celem.thm'' * term * Selem.result
wneuper@59416
   372
  | Rewrite_Inst' of Rule.theory' * Rule.rew_ord' * Rule.rls * bool * Rule.subst * Celem.thm'' * term * Selem.result
wneuper@59416
   373
  | Rewrite_Set' of Rule.theory' * bool * Rule.rls * term * Selem.result
wneuper@59416
   374
  | Rewrite_Set_Inst' of Rule.theory' * bool * Rule.subst * Rule.rls * term * Selem.result
wneuper@59302
   375
wneuper@59405
   376
  | Specify_Method' of Celem.metID * Model.ori list * Model.itm list
wneuper@59405
   377
  | Specify_Problem' of Celem.pblID * 
wneuper@59578
   378
    (bool *                  (* matches	                                  *)
wneuper@59578
   379
      (Model.itm list *      (* ppc	                                      *)
wneuper@59578
   380
        (bool * term) list)) (* preconditions                             *)
wneuper@59416
   381
  | Specify_Theory' of Rule.domID
wneuper@59302
   382
  | Subproblem' of
wneuper@59405
   383
    Celem.spec * 
wneuper@59578
   384
		(Model.ori list) *       (* filled in associate Subproblem'           *)
wneuper@59578
   385
		term *                   (* filled -"-, headline of calc-head         *)
wneuper@59533
   386
		Selem.fmz_ *             
wneuper@59578
   387
    Proof.context *          (* DEPRECATED shifted into loc for all ppobj *)
wneuper@59578
   388
		term                     (* Subproblem (thyID, pbl) OR cascmd         *)  
wneuper@59533
   389
  | Substitute' of           
wneuper@59578
   390
    Rule.rew_ord_ *          (* for re-calculation                        *)
wneuper@59578
   391
    Rule.rls *               (* for re-calculation                        *)
wneuper@59578
   392
    Selem.subte *            (* the 'substitution': terms of type bool    *)
wneuper@59578
   393
    term *                   (* to be substituted into                    *)
wneuper@59578
   394
    term                     (* resulting from the substitution           *)
wneuper@59302
   395
  | Tac_ of theory * string * string * string
wneuper@59302
   396
  | Take' of term | Take_Inst' of term
wneuper@59302
   397
wneuper@59302
   398
fun tac_2str ma = case ma of
wneuper@59405
   399
    Init_Proof' (ppc, spec)  => "Init_Proof' " ^ pair2str (strs2str ppc, Celem.spec2str spec)
wneuper@59302
   400
  | Model_Problem' (pblID, _, _) => "Model_Problem' " ^ strs2str pblID
wneuper@59302
   401
  | Refine_Tacitly'(p, prefin, domID, metID, _) => "Refine_Tacitly' (" ^ strs2str p ^ ", " ^
wneuper@59302
   402
    strs2str prefin ^ ", " ^ domID ^ ", " ^ strs2str metID ^ ", pbl-itms)"
wneuper@59302
   403
  | Refine_Problem' _ => "Refine_Problem' (" ^ (*matchs2str ms*)"..." ^ ")"
wneuper@59302
   404
  | Add_Given' _ => "Add_Given' "(*^cterm'*)
wneuper@59302
   405
  | Del_Given' _ => "Del_Given' "(*^cterm'*)
wneuper@59302
   406
  | Add_Find' _ => "Add_Find' "(*^cterm'*)
wneuper@59302
   407
  | Del_Find' _ => "Del_Find' "(*^cterm'*)
wneuper@59302
   408
  | Add_Relation' _ => "Add_Relation' "(*^cterm'*)
wneuper@59302
   409
  | Del_Relation' _ => "Del_Relation' "(*^cterm'*)
wneuper@59302
   410
wneuper@59302
   411
  | Specify_Theory' domID => "Specify_Theory' " ^ quote domID
wneuper@59302
   412
  | Specify_Problem' (pI, (ok, _)) =>  "Specify_Problem' " ^ 
wneuper@59302
   413
    spair2str (strs2str pI, spair2str (bool2str ok, spair2str ("itms2str_ itms", "items2str pre")))
wneuper@59302
   414
  | Specify_Method' (pI, oris, _) => "Specify_Method' (" ^ 
wneuper@59405
   415
    Celem.metID2str pI ^ ", " ^ Model.oris2str oris ^ ", )"
wneuper@59302
   416
wneuper@59302
   417
  | Apply_Method' (metID, _, _, _) => "Apply_Method' " ^ strs2str metID
wneuper@59302
   418
  | Check_Postcond' (pblID, (scval, asm)) => "Check_Postcond' " ^
wneuper@59416
   419
      (spair2str (strs2str pblID, spair2str (Rule.term2str scval, Rule.terms2str asm)))
wneuper@59302
   420
wneuper@59302
   421
  | Free_Solve' => "Free_Solve'"
wneuper@59302
   422
wneuper@59302
   423
  | Rewrite_Inst' (*subs,thm'*) _ => "Rewrite_Inst' "(*^(pair2str (subs2str subs, spair2str thm'))*)
wneuper@59302
   424
  | Rewrite' _(*thm'*) => "Rewrite' "(*^(spair2str thm')*)
wneuper@59302
   425
  | Rewrite_Asm' _(*thm'*) => "Rewrite_Asm' "(*^(spair2str thm')*)
wneuper@59302
   426
  | Rewrite_Set_Inst' _(*subs,thm'*) => "Rewrite_Set_Inst' "(*^(pair2str (subs2str subs, quote rls))*)
wneuper@59302
   427
  | Rewrite_Set' (thy', pasm, rls', f, (f', asm)) => "Rewrite_Set' (" ^ thy' ^ "," ^ bool2str pasm ^
wneuper@59416
   428
    "," ^ Rule.id_rls rls' ^ "," ^ Rule.term2str f ^ ",(" ^ Rule.term2str f' ^ "," ^ Rule.terms2str asm ^ "))"
wneuper@59302
   429
  | End_Detail' _ => "End_Detail' xxx"
wneuper@59302
   430
  | Detail_Set' _ => "Detail_Set' xxx"
wneuper@59302
   431
  | Detail_Set_Inst' _ => "Detail_Set_Inst' xxx"
wneuper@59302
   432
wneuper@59416
   433
  | Derive' rls => "Derive' " ^ Rule.id_rls rls
wneuper@59302
   434
  | Calculate'  _ => "Calculate' "
wneuper@59302
   435
  | Substitute' _ => "Substitute' "(*^(subs2str subs)*)    
wneuper@59302
   436
  | Apply_Assumption' _(* ct's*) => "Apply_Assumption' "(*^(strs2str ct's)*)
wneuper@59302
   437
wneuper@59302
   438
  | Take' _(*cterm'*) => "Take' "(*^(quote cterm'	)*)
wneuper@59302
   439
  | Take_Inst' _(*cterm'*) => "Take_Inst' "(*^(quote cterm' )*)
wneuper@59302
   440
  | Subproblem' _(*(spec, oris, _, _, _, pbl_form)*) => 
wneuper@59302
   441
    "Subproblem' "(*^(pair2str (domID, strs2str ,))*)
wneuper@59302
   442
  | End_Subproblem' _ => "End_Subproblem'"
wneuper@59302
   443
  | CAScmd' _(*cterm'*) => "CAScmd' "(*^(quote cterm')*)
wneuper@59302
   444
wneuper@59302
   445
  | Empty_Tac_ => "Empty_Tac_"
wneuper@59302
   446
  | Tac_ (_, form, id, result) => "Tac_ (thy," ^ form ^ "," ^ id ^ "," ^ result ^ ")"
wneuper@59302
   447
  | _  => "tac_2str not impl. for arg";
wneuper@59302
   448
walther@59704
   449
fun input_from_T (Refine_Tacitly' (pI, _, _, _, _)) = Refine_Tacitly pI
walther@59704
   450
  | input_from_T (Model_Problem' (_, _, _)) = Model_Problem
walther@59704
   451
  | input_from_T (Add_Given' (t, _)) = Add_Given t
walther@59704
   452
  | input_from_T (Add_Find' (t, _)) = Add_Find t
walther@59704
   453
  | input_from_T (Add_Relation' (t, _)) = Add_Relation t
walther@59704
   454
 
walther@59704
   455
  | input_from_T (Specify_Theory' dI) = Specify_Theory dI
walther@59704
   456
  | input_from_T (Specify_Problem' (dI, _)) = Specify_Problem dI
walther@59704
   457
  | input_from_T (Specify_Method' (dI, _, _)) = Specify_Method dI
walther@59704
   458
  
walther@59704
   459
  | input_from_T (Rewrite' (_, _, _, _, thm, _, _)) = Rewrite thm
walther@59704
   460
  | input_from_T (Rewrite_Inst' (_, _, _, _, sub, thm, _, _)) = Rewrite_Inst (Selem.subst2subs sub, thm)
walther@59704
   461
walther@59704
   462
  | input_from_T (Rewrite_Set' (_, _, rls, _, _)) = Rewrite_Set (Rule.id_rls rls)
walther@59704
   463
  | input_from_T (Detail_Set' (_, _, rls, _, _)) = Detail_Set (Rule.id_rls rls)
walther@59704
   464
walther@59704
   465
  | input_from_T (Rewrite_Set_Inst' (_, _, sub, rls, _, _)) = 
walther@59704
   466
    Rewrite_Set_Inst (Selem.subst2subs sub, Rule.id_rls rls)
walther@59704
   467
  | input_from_T (Detail_Set_Inst' (_, _, sub, rls, _, _)) = 
walther@59704
   468
    Detail_Set_Inst (Selem.subst2subs sub, Rule.id_rls rls)
walther@59704
   469
walther@59704
   470
  | input_from_T (Calculate' (_, op_, _, _)) = Calculate (op_)
walther@59704
   471
  | input_from_T (Check_elementwise' (_, pred, _)) = Check_elementwise pred
walther@59704
   472
walther@59704
   473
  | input_from_T (Or_to_List' _) = Or_to_List
walther@59704
   474
  | input_from_T (Take' term) = Take (Rule.term2str term)
walther@59704
   475
  | input_from_T (Substitute' (_, _, subte, _, _)) = Substitute (Selem.subte2sube subte) 
walther@59704
   476
  | input_from_T (Tac_ (_, _, id, _)) = Tac id
walther@59704
   477
walther@59704
   478
  | input_from_T (Subproblem' ((domID, pblID, _), _, _, _,_ ,_)) = Subproblem (domID, pblID)
walther@59704
   479
  | input_from_T (Check_Postcond' (pblID, _)) = Check_Postcond pblID
walther@59704
   480
  | input_from_T Empty_Tac_ = Empty_Tac
walther@59704
   481
  | input_from_T m = error (": not impl. for "^(tac_2str m));
walther@59704
   482
wneuper@59298
   483
end