src/Tools/isac/MathEngBasic/tactic.sml
author Walther Neuper <walther.neuper@jku.at>
Thu, 20 Feb 2020 18:47:55 +0100
changeset 59812 9ef6e9e88178
parent 59785 b5de2ec15f36
child 59844 373d13915f8c
permissions -rw-r--r--
cleanup Tactic and prep.shift after Ctree
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@59812
    12
  datatype T = datatype Tactic_Def.T
walther@59812
    13
  val string_of: T -> string
walther@59741
    14
walther@59812
    15
  datatype input = datatype Tactic_Def.input
wneuper@59571
    16
  val tac2str : input -> string
walther@59812
    17
  val tac2IDstr : input -> string
walther@59778
    18
  val is_empty_tac : input -> bool
wneuper@59302
    19
walther@59778
    20
(*//-------------------------------------------------------------- only AFTER ctree.sml required *)
walther@59728
    21
  val eq_tac : input * input -> bool
walther@59728
    22
  val is_rewtac : input -> bool
walther@59728
    23
  val is_rewset : input -> bool
walther@59728
    24
  val rls_of : input -> Rule.rls'
walther@59728
    25
  val rule2tac : theory -> (term * term) list ->  Rule.rule -> input
walther@59704
    26
  val input_from_T : T -> input
walther@59728
    27
  val result : T -> term
walther@59728
    28
  val creates_assms: T -> term list
walther@59728
    29
  val insert_assumptions: T -> Proof.context -> Proof.context
walther@59749
    30
  val for_specify: input -> bool
walther@59749
    31
  val for_specify': T -> bool
walther@59735
    32
wneuper@59310
    33
(* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
wneuper@59310
    34
  (* NONE *)
walther@59785
    35
(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
wneuper@59310
    36
  (* NONE *)
walther@59785
    37
( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
wneuper@59298
    38
wneuper@59310
    39
(*----- unused code, kept as hints to design ideas ---------------------------------------------*)
wneuper@59310
    40
  (* NONE *)
wneuper@59298
    41
end
wneuper@59298
    42
walther@59728
    43
(**)
wneuper@59571
    44
structure Tactic(**): TACTIC(**) =
wneuper@59298
    45
struct
walther@59728
    46
(**)
wneuper@59298
    47
walther@59812
    48
datatype input = datatype Tactic_Def.input
wneuper@59302
    49
walther@59812
    50
val tac2str = Tactic_Def.tac2str
walther@59812
    51
val tac2IDstr = Tactic_Def.tac2IDstr
walther@59812
    52
val is_empty_tac = Tactic_Def.is_empty_tac
wneuper@59302
    53
wneuper@59302
    54
fun eq_tac (Rewrite (id1, _), Rewrite (id2, _)) = id1 = id2
wneuper@59302
    55
  | eq_tac (Rewrite_Inst (_, (id1, _)), Rewrite_Inst (_, (id2, _))) = id1 = id2
wneuper@59302
    56
  | eq_tac (Rewrite_Set id1, Rewrite_Set id2) = id1 = id2
wneuper@59302
    57
  | eq_tac (Rewrite_Set_Inst (_, id1), Rewrite_Set_Inst (_, id2)) = id1 = id2
wneuper@59302
    58
  | eq_tac (Calculate id1, Calculate id2) = id1 = id2
wneuper@59302
    59
  | eq_tac _ = false
wneuper@59302
    60
wneuper@59302
    61
fun is_rewset (Rewrite_Set_Inst _) = true
wneuper@59302
    62
  | is_rewset (Rewrite_Set _) = true 
wneuper@59302
    63
  | is_rewset _ = false;
wneuper@59302
    64
fun is_rewtac (Rewrite _) = true
wneuper@59302
    65
  | is_rewtac (Rewrite_Inst _) = true
wneuper@59571
    66
  | is_rewtac input = is_rewset input;
wneuper@59302
    67
wneuper@59302
    68
wneuper@59302
    69
fun rls_of (Rewrite_Set_Inst (_, rls)) = rls
wneuper@59302
    70
  | rls_of (Rewrite_Set rls) = rls
walther@59812
    71
  | rls_of input = error ("rls_of: called with input \"" ^ Tactic_Def.tac2IDstr input ^ "\"");
wneuper@59302
    72
walther@59773
    73
fun rule2tac thy _ (Rule.Num_Calc (opID, _)) = Calculate (assoc_calc thy opID)
wneuper@59416
    74
  | rule2tac _ [] (Rule.Thm thm'') = Rewrite thm''
wneuper@59416
    75
  | rule2tac _ subst (Rule.Thm thm'') = 
wneuper@59302
    76
    Rewrite_Inst (Selem.subst2subs subst, thm'')
wneuper@59416
    77
  | rule2tac _ [] (Rule.Rls_ rls) = Rewrite_Set (Rule.id_rls rls)
wneuper@59416
    78
  | rule2tac _ subst (Rule.Rls_ rls) = 
wneuper@59416
    79
    Rewrite_Set_Inst (Selem.subst2subs subst, (Rule.id_rls rls))
wneuper@59302
    80
  | rule2tac _ _ rule = 
wneuper@59416
    81
    error ("rule2tac: called with \"" ^ Rule.rule2str rule ^ "\"");
wneuper@59302
    82
walther@59812
    83
  datatype T = datatype Tactic_Def.T
wneuper@59302
    84
walther@59812
    85
val string_of = Tactic_Def.string_of
wneuper@59302
    86
walther@59704
    87
fun input_from_T (Refine_Tacitly' (pI, _, _, _, _)) = Refine_Tacitly pI
walther@59704
    88
  | input_from_T (Model_Problem' (_, _, _)) = Model_Problem
walther@59704
    89
  | input_from_T (Add_Given' (t, _)) = Add_Given t
walther@59704
    90
  | input_from_T (Add_Find' (t, _)) = Add_Find t
walther@59704
    91
  | input_from_T (Add_Relation' (t, _)) = Add_Relation t
walther@59704
    92
 
walther@59704
    93
  | input_from_T (Specify_Theory' dI) = Specify_Theory dI
walther@59704
    94
  | input_from_T (Specify_Problem' (dI, _)) = Specify_Problem dI
walther@59704
    95
  | input_from_T (Specify_Method' (dI, _, _)) = Specify_Method dI
walther@59704
    96
  
walther@59704
    97
  | input_from_T (Rewrite' (_, _, _, _, thm, _, _)) = Rewrite thm
walther@59704
    98
  | input_from_T (Rewrite_Inst' (_, _, _, _, sub, thm, _, _)) = Rewrite_Inst (Selem.subst2subs sub, thm)
walther@59704
    99
walther@59704
   100
  | input_from_T (Rewrite_Set' (_, _, rls, _, _)) = Rewrite_Set (Rule.id_rls rls)
walther@59704
   101
  | input_from_T (Detail_Set' (_, _, rls, _, _)) = Detail_Set (Rule.id_rls rls)
walther@59704
   102
walther@59704
   103
  | input_from_T (Rewrite_Set_Inst' (_, _, sub, rls, _, _)) = 
walther@59704
   104
    Rewrite_Set_Inst (Selem.subst2subs sub, Rule.id_rls rls)
walther@59704
   105
  | input_from_T (Detail_Set_Inst' (_, _, sub, rls, _, _)) = 
walther@59704
   106
    Detail_Set_Inst (Selem.subst2subs sub, Rule.id_rls rls)
walther@59704
   107
walther@59704
   108
  | input_from_T (Calculate' (_, op_, _, _)) = Calculate (op_)
walther@59704
   109
  | input_from_T (Check_elementwise' (_, pred, _)) = Check_elementwise pred
walther@59704
   110
walther@59704
   111
  | input_from_T (Or_to_List' _) = Or_to_List
walther@59704
   112
  | input_from_T (Take' term) = Take (Rule.term2str term)
walther@59704
   113
  | input_from_T (Substitute' (_, _, subte, _, _)) = Substitute (Selem.subte2sube subte) 
walther@59704
   114
  | input_from_T (Tac_ (_, _, id, _)) = Tac id
walther@59704
   115
walther@59704
   116
  | input_from_T (Subproblem' ((domID, pblID, _), _, _, _,_ ,_)) = Subproblem (domID, pblID)
walther@59704
   117
  | input_from_T (Check_Postcond' (pblID, _)) = Check_Postcond pblID
walther@59704
   118
  | input_from_T Empty_Tac_ = Empty_Tac
walther@59812
   119
  | input_from_T m = raise ERROR (": not impl. for "^(Tactic_Def.string_of m));
walther@59704
   120
walther@59728
   121
fun res (Rewrite_Inst' (_ , _, _, _, _, _, _, res)) = res
walther@59728
   122
  | res (Rewrite' (_, _, _, _, _, _, res)) = res
walther@59728
   123
  | res (Rewrite_Set_Inst' (_, _, _, _, _, res)) = res
walther@59728
   124
  | res (Rewrite_Set' (_, _, _, _, res)) = res
walther@59728
   125
  | res (Calculate' (_, _, _, (t, _))) = (t, [])
walther@59728
   126
  | res (Check_elementwise' (_, _, res)) = res
walther@59728
   127
  | res (Subproblem' (_, _, _, _, _, t)) = (t, [])
walther@59728
   128
  | res (Take' t) = (t, [])
walther@59728
   129
  | res (Substitute' (_, _, _, _, t)) = (t, [])
walther@59728
   130
  | res (Or_to_List' (_,  t)) = (t, [])
walther@59812
   131
  | res m = raise ERROR ("result: not impl.for " ^ Tactic_Def.string_of m)
walther@59728
   132
walther@59728
   133
(*fun result m = (fst o res) m; TODO*)
walther@59728
   134
fun result tac = (fst o res) tac;
walther@59728
   135
fun creates_assms tac = (snd o res) tac;
walther@59728
   136
walther@59728
   137
fun insert_assumptions tac ctxt  = ContextC.insert_assumptions (creates_assms tac) ctxt
walther@59728
   138
walther@59749
   139
fun for_specify (Init_Proof _) = true
walther@59749
   140
  | for_specify Model_Problem  = true
walther@59749
   141
  | for_specify (Refine_Tacitly _) = true
walther@59749
   142
  | for_specify (Refine_Problem _) = true
walther@59749
   143
  | for_specify (Add_Given _) = true
walther@59749
   144
  | for_specify (Del_Given _) = true
walther@59749
   145
  | for_specify (Add_Find _) = true
walther@59749
   146
  | for_specify (Del_Find _) = true
walther@59749
   147
  | for_specify (Add_Relation _) = true
walther@59749
   148
  | for_specify (Del_Relation _) = true
walther@59749
   149
  | for_specify (Specify_Theory _) = true
walther@59749
   150
  | for_specify (Specify_Problem _) = true
walther@59749
   151
  | for_specify (Specify_Method _) = true
walther@59749
   152
  | for_specify _ = false
walther@59749
   153
fun for_specify' (Init_Proof' _) = true
walther@59749
   154
  | for_specify' (Model_Problem' _) = true
walther@59749
   155
  | for_specify' (Refine_Tacitly' _) = true
walther@59749
   156
  | for_specify' (Refine_Problem' _) = true
walther@59749
   157
  | for_specify' (Add_Given' _) = true
walther@59749
   158
  | for_specify' (Del_Given' _) = true
walther@59749
   159
  | for_specify' (Add_Find' _) = true
walther@59749
   160
  | for_specify' (Del_Find' _) = true
walther@59749
   161
  | for_specify' (Add_Relation' _) = true
walther@59749
   162
  | for_specify' (Del_Relation' _) = true
walther@59749
   163
  | for_specify' (Specify_Theory' _) = true
walther@59749
   164
  | for_specify' (Specify_Problem' _) = true
walther@59749
   165
  | for_specify' (Specify_Method' _) = true
walther@59749
   166
  | for_specify' _ = false
walther@59749
   167
walther@59728
   168
(**)end(**)