src/Tools/isac/MathEngine/mathengine-stateless.sml
author Walther Neuper <walther.neuper@jku.at>
Tue, 21 Apr 2020 15:42:50 +0200
changeset 59898 68883c046963
parent 59886 106e7d8723ca
child 59903 5037ca1b112b
permissions -rw-r--r--
replace Celem. with new struct.s in BaseDefinitions/

Note: the remaining code in calcelems.sml shall be destributed to respective struct.s
walther@59787
     1
(* MathEngine/mathengine-stateless.sml
walther@59787
     2
   The _functional_ mathematics engine, ie. without a state.
neuper@37906
     3
   Input and output are Isabelle's formulae as strings.
neuper@37906
     4
   authors: Walther Neuper 2000
neuper@37906
     5
   (c) due to copyright terms
neuper@37906
     6
*)
neuper@37906
     7
wneuper@59261
     8
signature MATH_ENGINE =
wneuper@59261
     9
sig
walther@59846
    10
  val autocalc : Pos.pos' list -> Pos.pos' -> (Calc.T) * Generate.taci list ->
walther@59846
    11
    Solve.auto -> string * Pos.pos' list * (Calc.T)
neuper@37906
    12
walther@59846
    13
  val initcontext_met : Ctree.ctree -> Pos.pos' -> bool * string list * Program.T * Model.itm list * (bool * term) list
walther@59846
    14
  val initcontext_pbl : Ctree.ctree -> Pos.pos' -> bool * string list * term * Model.itm list * (bool * term) list
walther@59898
    15
  val context_met : Spec.metID -> Ctree.ctree -> Pos.pos -> bool * Spec.metID * Program.T * Model.itm list * (bool * term) list
walther@59898
    16
  val context_pbl : Spec.pblID -> Ctree.ctree -> Pos.pos -> bool * Spec.pblID * term * Model.itm list * (bool * term) list
walther@59898
    17
  val set_method : Spec.metID -> Calc.T -> Ctree.ctree * Ctree.ocalhd
walther@59898
    18
  val set_problem : Spec.pblID -> Calc.T -> Ctree.ctree * Ctree.ocalhd
walther@59879
    19
  val set_theory : ThyC.id -> Calc.T -> Ctree.ctree * Ctree.ocalhd
walther@59898
    20
  val tryrefine : Spec.pblID -> Ctree.ctree -> Pos.pos' -> bool * Spec.pblID * term * Model.itm list * (bool * term) list
wneuper@59310
    21
(* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
walther@59814
    22
  (*NONE*)
walther@59886
    23
(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
walther@59814
    24
  (*NONE*)
walther@59886
    25
( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
wneuper@59310
    26
wneuper@59310
    27
(*----- unused code, kept as hints to design ideas ---------------------------------------------*)
wneuper@59310
    28
  (* NONE *)
wneuper@59261
    29
end
neuper@37906
    30
wneuper@59261
    31
(**)
wneuper@59261
    32
structure Math_Engine(**): MATH_ENGINE(**) =
wneuper@59261
    33
struct
wneuper@59261
    34
(**)
neuper@37906
    35
neuper@37906
    36
datatype nxt_ =
wneuper@59261
    37
	HElpless  (**)
wneuper@59265
    38
| Nexts of Chead.calcstate (**)
neuper@37906
    39
wneuper@59261
    40
(* specify a new method; WN0512 impl.incomplete, see 'nxt_specif (Specify_Method ' *)
wneuper@59276
    41
fun set_method mI ptp =
wneuper@59261
    42
  let
wneuper@59261
    43
    val (mits, pt, p) =
walther@59806
    44
      case Step_Specify.by_tactic_input (Tactic.Specify_Method mI) ptp of
wneuper@59571
    45
        ([(_, Tactic.Specify_Method' (_, _, mits), _)], [], (pt, (p, _))) => (mits, pt, p)
wneuper@59261
    46
      | _ => error "set_method: case 1 uncovered"
wneuper@59261
    47
  	val pre = []        (*...from Specify_Method'*)
wneuper@59261
    48
  	val complete = true (*...from Specify_Method'*)
wneuper@59261
    49
  	(*from Specify_Method'  ?   vvv,  vvv ?*)
wneuper@59261
    50
    val (hdf, spec) =
wneuper@59276
    51
      case Ctree.get_obj I pt p of
wneuper@59276
    52
        Ctree.PblObj {origin = (_, _, hdf), spec, ...} => (hdf, spec)
wneuper@59276
    53
      | Ctree.PrfObj _ => error "set_method: case 2 uncovered"
wneuper@59261
    54
  in
walther@59694
    55
    (pt, (complete, Pos.Met, hdf, mits, pre, spec) : Ctree.ocalhd)
wneuper@59261
    56
  end
neuper@37906
    57
wneuper@59261
    58
(* specify a new problem; WN0512 impl.incomplete, see 'nxt_specif (Specify_Problem ' *)
wneuper@59276
    59
fun set_problem pI ptp =
wneuper@59261
    60
  let
wneuper@59261
    61
    val (complete, pits, pre, pt, p) =
walther@59806
    62
      case Step_Specify.by_tactic_input (Tactic.Specify_Problem pI) ptp of
walther@59794
    63
        ([(_, Tactic.Specify_Problem' (_, (complete, (pits, pre))), _)], _, (pt, (p, _)))
wneuper@59261
    64
          => (complete, pits, pre, pt, p)
wneuper@59261
    65
      | _ => error "set_problem: case 1 uncovered"
wneuper@59261
    66
    (*from Specify_Problem' ?   vvv,  vvv ?*)
wneuper@59261
    67
    val (hdf, spec) =
wneuper@59276
    68
      case Ctree.get_obj I pt p of
wneuper@59276
    69
        Ctree.PblObj {origin = (_, _, hdf), spec, ...} => (hdf, spec)
wneuper@59276
    70
      | Ctree.PrfObj _ => error "set_problem: case 2 uncovered"
wneuper@59261
    71
  in
walther@59694
    72
    (pt, (complete, Pos.Pbl, hdf, pits, pre, spec) : Ctree.ocalhd)
wneuper@59261
    73
  end
neuper@37906
    74
wneuper@59276
    75
fun set_theory tI ptp =
wneuper@59261
    76
  let
wneuper@59261
    77
    val (complete, pits, pre, pt, p) =
walther@59806
    78
      case Step_Specify.by_tactic_input (Tactic.Specify_Theory tI) ptp of  
wneuper@59571
    79
        ([(_, Tactic.Specify_Problem' (_, (complete, (pits, pre))), _)], _, (pt, (p, _)))
wneuper@59261
    80
          => (complete, pits, pre, pt, p)
wneuper@59261
    81
      | _ => error "set_theory: case 1 uncovered"
wneuper@59261
    82
  	(*from Specify_Theory'  ?   vvv,  vvv ?*)
wneuper@59261
    83
    val (hdf, spec) =
wneuper@59276
    84
      case Ctree.get_obj I pt p of
wneuper@59276
    85
        Ctree.PblObj {origin = (_, _, hdf), spec, ...} => (hdf, spec)
wneuper@59276
    86
      | Ctree.PrfObj _ => error "set_theory: case 2 uncovered"
walther@59694
    87
  in (pt, (complete, Pos.Pbl, hdf, pits, pre, spec) : Ctree.ocalhd) end;
neuper@37906
    88
wneuper@59261
    89
(* does several steps within one calculation as given by "type auto";
neuper@37906
    90
   the steps may arbitrarily go into and leave different phases, 
wneuper@59569
    91
   i.e. specify-phase and solve-phase *)
walther@59747
    92
fun autocalc c ip cs (Solve.Steps s) =
neuper@37906
    93
    if s <= 1
wneuper@59261
    94
    then
walther@59765
    95
      let val (str, (_, c', ptp)) = Step.do_next ip cs;      (* autoord = 1, probably does 1 do_next too much*)
wneuper@59261
    96
	    in (str, c@c', ptp) end
wneuper@59261
    97
    else
walther@59765
    98
      let val (str, (_, c', ptp as (_, p))) = Step.do_next ip cs;
wneuper@59261
    99
      in
wneuper@59261
   100
        if str = "ok" 
walther@59747
   101
        then autocalc (c@c') p (ptp, []) (Solve.Steps (s - 1))
wneuper@59261
   102
        else (str, c@c', ptp) end
wneuper@59261
   103
    (* handles autoord <= 3, autoord > 3 handled by all_solve, complete_solve *)
wneuper@59261
   104
  | autocalc c (pos as (_, p_)) ((pt, _), _(*tacis could help 1x in solve*)) auto =
wneuper@59276
   105
    if Solve.autoord auto > 3 andalso Ctree.just_created (pt, pos)
wneuper@59261
   106
    then
wneuper@59265
   107
      let val ptp = Chead.all_modspec (pt, pos);
wneuper@59273
   108
      in Solve.all_solve auto c ptp end                    (*... auto = 4 | 5 | 6 *)
wneuper@59261
   109
    else
walther@59694
   110
      if member op = [Pos.Pbl, Pos.Met] p_
wneuper@59261
   111
      then
wneuper@59265
   112
        if not (Chead.is_complete_mod (pt, pos))
wneuper@59261
   113
   	    then
wneuper@59265
   114
   	      let val ptp = Chead.complete_mod (pt, pos)      (*... auto = 2 | 3 *)
wneuper@59261
   115
   		    in
wneuper@59273
   116
   		      if Solve.autoord auto < 3 then ("ok", c, ptp)
wneuper@59261
   117
   		      else
wneuper@59265
   118
   		       if not (Chead.is_complete_spec ptp)
wneuper@59261
   119
   			     then
wneuper@59265
   120
   			       let val ptp = Chead.complete_spec ptp
wneuper@59261
   121
   			       in
wneuper@59273
   122
   			         if Solve.autoord auto = 3 then ("ok", c, ptp) else Solve.all_solve auto c ptp
wneuper@59261
   123
   			       end
wneuper@59273
   124
   			     else if Solve.autoord auto = 3 then ("ok", c, ptp) else Solve.all_solve auto c ptp 
wneuper@59261
   125
   		    end
wneuper@59261
   126
   	    else 
wneuper@59265
   127
   		    if not (Chead.is_complete_spec (pt,pos))
wneuper@59261
   128
   		    then
wneuper@59265
   129
   		      let val ptp = Chead.complete_spec (pt, pos)
wneuper@59261
   130
   		      in
wneuper@59273
   131
   		        if Solve.autoord auto = 3 then ("ok", c, ptp) else Solve.all_solve auto c ptp
wneuper@59261
   132
   		      end
wneuper@59261
   133
   		    else
wneuper@59273
   134
   		      if Solve.autoord auto = 3 then ("ok", c, (pt, pos)) else Solve.all_solve auto c (pt, pos)
wneuper@59273
   135
   	  else Solve.complete_solve auto c (pt, pos);
neuper@37906
   136
neuper@37906
   137
(*.initialiye matching; before 'tryMatch' get the pblID to match with:
neuper@37906
   138
   if no pbl has been specified, take the init from origin.*)
wneuper@59261
   139
fun initcontext_pbl pt (p, _) =
wneuper@59261
   140
  let
wneuper@59261
   141
    val (probl, os, pI, hdl, pI') =
wneuper@59276
   142
      case Ctree.get_obj I pt p of
wneuper@59276
   143
        Ctree.PblObj {probl, origin = (os, (_, pI, _), hdl), spec=(_, pI', _), ...}
wneuper@59261
   144
          => (probl, os, pI, hdl, pI')
wneuper@59276
   145
      | Ctree.PrfObj _ => error "initcontext_pbl: uncovered case"
wneuper@59261
   146
  	val pblID =
walther@59898
   147
  	  if pI' = Spec.e_pblID 
wneuper@59261
   148
  		then (* TODO.WN051125 (#init o get_pbt) pI *) takelast (2, pI)
wneuper@59261
   149
  		else pI'
wneuper@59269
   150
  	val {ppc, where_, prls, ...} = Specify.get_pbt pblID
walther@59881
   151
  	val (model_ok, (pbl, pre)) = Specify.match_itms_oris (ThyC.get_theory "Isac_Knowledge") probl (ppc, where_, prls) os
wneuper@59261
   152
  in
wneuper@59261
   153
    (model_ok, pblID, hdl, pbl, pre)
wneuper@59261
   154
  end
neuper@37906
   155
wneuper@59261
   156
fun initcontext_met pt (p,_) =
wneuper@59261
   157
  let
wneuper@59261
   158
    val (meth, os, mI, mI') =
wneuper@59276
   159
      case Ctree.get_obj I pt p of
wneuper@59276
   160
        Ctree.PblObj {meth, origin = (os, (_, _, mI), _), spec=(_, _, mI'), ...} => (meth, os, mI, mI')
wneuper@59276
   161
      | Ctree.PrfObj _ => error "initcontext_met: uncovered case"
walther@59898
   162
  	val metID = if mI' = Spec.e_metID 
wneuper@59261
   163
  		    then (*TODO.WN051125 (#init o get_pbt) pI *) takelast (2, mI)
wneuper@59261
   164
  		    else mI'
wneuper@59269
   165
  	val {ppc, pre, prls, scr, ...} = Specify.get_met metID
walther@59881
   166
  	val (model_ok, (pbl, pre)) = Specify.match_itms_oris (ThyC.get_theory "Isac_Knowledge") meth (ppc,pre,prls) os
wneuper@59261
   167
  in
wneuper@59261
   168
    (model_ok, metID, scr, pbl, pre)
wneuper@59261
   169
  end
neuper@37906
   170
wneuper@59261
   171
(* match the model of a problem at pos p with the model-pattern of the problem with pblID *)
wneuper@59276
   172
fun context_pbl pI pt p =
wneuper@59261
   173
  let
wneuper@59261
   174
    val (probl, os, hdl) =
wneuper@59276
   175
      case Ctree.get_obj I pt p of
wneuper@59276
   176
        Ctree.PblObj {probl,origin = (os, _, hdl),...} => (probl, os, hdl)
wneuper@59276
   177
      | Ctree.PrfObj _ => error "context_pbl: uncovered case"
wneuper@59269
   178
  	val {ppc,where_,prls,...} = Specify.get_pbt pI
walther@59881
   179
  	val (model_ok, (pbl, pre)) = Specify.match_itms_oris (ThyC.get_theory "Isac_Knowledge") probl (ppc,where_,prls) os
wneuper@59261
   180
  in
wneuper@59261
   181
    (model_ok, pI, hdl, pbl, pre)
wneuper@59261
   182
  end
neuper@37906
   183
wneuper@59276
   184
fun context_met mI pt p =
wneuper@59261
   185
  let
wneuper@59261
   186
    val (meth, os) =
wneuper@59276
   187
      case Ctree.get_obj I pt p of
wneuper@59276
   188
        Ctree.PblObj {meth, origin = (os, _, _),...} => (meth, os)
wneuper@59276
   189
      | Ctree.PrfObj _ => error "context_met: uncovered case"
wneuper@59269
   190
  	val {ppc,pre,prls,scr,...} = Specify.get_met mI
walther@59881
   191
  	val (model_ok, (pbl, pre)) = Specify.match_itms_oris (ThyC.get_theory "Isac_Knowledge") meth (ppc,pre,prls) os
wneuper@59261
   192
  in
wneuper@59261
   193
    (model_ok, mI, scr, pbl, pre)
wneuper@59261
   194
  end
neuper@37906
   195
wneuper@59261
   196
fun tryrefine pI pt (p,_) =
wneuper@59261
   197
  let
wneuper@59261
   198
    val (probl, os, hdl) =
wneuper@59276
   199
      case Ctree.get_obj I pt p of
wneuper@59276
   200
        Ctree.PblObj {probl, origin = (os, _, hdl), ...} => (probl, os, hdl)
wneuper@59276
   201
      | Ctree.PrfObj _ => error "context_met: uncovered case"
wneuper@59261
   202
  in
walther@59881
   203
    case Specify.refine_pbl (ThyC.get_theory "Isac_Knowledge") pI probl of
wneuper@59261
   204
  	  NONE => (*copy from context_pbl*)
wneuper@59261
   205
  	    let
wneuper@59269
   206
  	      val {ppc,where_,prls,...} = Specify.get_pbt pI
walther@59881
   207
  	      val (_, (pbl, pre)) = Specify.match_itms_oris (ThyC.get_theory "Isac_Knowledge") probl (ppc,where_,prls) os
wneuper@59261
   208
        in
wneuper@59261
   209
          (false, pI, hdl, pbl, pre)
wneuper@59261
   210
        end
wneuper@59261
   211
  	| SOME (pI, (pbl, pre)) => (true, pI, hdl, pbl, pre) 
wneuper@59261
   212
  end
neuper@37906
   213
walther@59749
   214
(**)end(**)