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