src/Tools/isac/Frontend/interface.sml
author Walther Neuper <neuper@ist.tugraz.at>
Mon, 06 Aug 2012 16:19:30 +0200
changeset 42458 4d7502e18f18
parent 42450 429980a4c472
child 55402 d580d7fc9b8e
permissions -rw-r--r--
fetchProposedTactic returns Tactic + errpatID list
neuper@37906
     1
(* the interface between the isac-kernel and the java-frontend;
neuper@37906
     2
   the isac-kernel holds calc-trees; stdout in XML-format.
neuper@37906
     3
   authors: Walther Neuper 2002
neuper@37906
     4
   (c) due to copyright terms
neuper@37906
     5
neuper@37947
     6
use"Frontend/interface.sml";
neuper@37906
     7
use"interface.sml";
neuper@37906
     8
*)
neuper@37906
     9
neuper@37906
    10
signature INTERFACE =
neuper@37906
    11
  sig
neuper@37906
    12
    val CalcTree : fmz list -> unit
neuper@37906
    13
    val DEconstrCalcTree : calcID -> unit
neuper@37906
    14
    val Iterator : calcID -> unit
neuper@37906
    15
    val IteratorTEST : calcID -> iterID
neuper@37906
    16
    val appendFormula : calcID -> cterm' -> unit
neuper@37906
    17
    val autoCalculate : calcID -> auto -> unit
neuper@37906
    18
    val checkContext : calcID -> pos' -> guh -> unit
neuper@37906
    19
    val fetchApplicableTactics : calcID -> int -> pos' -> unit
neuper@37906
    20
    val fetchProposedTactic : calcID -> unit
neuper@37906
    21
    val applyTactic : calcID -> pos' -> tac -> unit
neuper@37906
    22
    val getAccumulatedAsms : calcID -> pos' -> unit
neuper@37906
    23
    val getActiveFormula : calcID -> unit
neuper@37906
    24
    val getAssumptions : calcID -> pos' -> unit
neuper@37906
    25
    val initContext : calcID -> ketype -> pos' -> unit
neuper@37906
    26
    val getFormulaeFromTo : calcID -> pos' -> pos' -> int -> bool -> unit
neuper@37906
    27
    val getTactic : calcID -> pos' -> unit
neuper@37906
    28
    val interSteps : calcID -> pos' -> unit
neuper@37906
    29
    val modifyCalcHead : calcID -> icalhd -> unit
neuper@37906
    30
    val moveActiveCalcHead : calcID -> unit
neuper@37906
    31
    val moveActiveDown : calcID -> unit
neuper@37906
    32
    val moveActiveDownTEST : calcID -> unit
neuper@37906
    33
    val moveActiveFormula : calcID -> pos' -> unit
neuper@37906
    34
    val moveActiveLevelDown : calcID -> unit
neuper@37906
    35
    val moveActiveLevelUp : calcID -> unit
neuper@37906
    36
    val moveActiveRoot : calcID -> unit
neuper@37906
    37
    val moveActiveRootTEST : calcID -> unit
neuper@37906
    38
    val moveActiveUp : calcID -> unit
neuper@37906
    39
    val moveCalcHead : calcID -> pos' -> unit
neuper@37906
    40
    val moveDown : calcID -> pos' -> unit
neuper@37906
    41
    val moveLevelDown : calcID -> pos' -> unit
neuper@37906
    42
    val moveLevelUp : calcID -> pos' -> unit
neuper@37906
    43
    val moveRoot : calcID -> unit
neuper@37906
    44
    val moveUp : calcID -> pos' -> unit
neuper@37906
    45
    val refFormula : calcID -> pos' -> unit
neuper@37906
    46
    val replaceFormula : calcID -> cterm' -> unit
neuper@37906
    47
    val resetCalcHead : calcID -> unit
neuper@37906
    48
    val modelProblem : calcID -> unit
neuper@37906
    49
    val refineProblem : calcID -> pos' -> guh -> unit
neuper@37906
    50
    val setContext : calcID -> pos' -> guh -> unit
neuper@37906
    51
    val setMethod : calcID -> metID -> unit
neuper@37906
    52
    val setNextTactic : calcID -> tac -> unit
neuper@37906
    53
    val setProblem : calcID -> pblID -> unit
neuper@37906
    54
    val setTheory : calcID -> thyID -> unit
neuper@42433
    55
    val findFillpatterns : calcID -> errpatID -> unit
neuper@42432
    56
    val requestFillformula : calcID -> errpatID * fillpatID -> unit
neuper@42437
    57
    val inputFillFormula: calcID -> string -> unit
neuper@42124
    58
(*------------ for tests*)
neuper@42124
    59
val encode: cterm' -> cterm'
neuper@42124
    60
val encode_fmz: fmz -> fmz
neuper@37906
    61
  end
neuper@37906
    62
neuper@37906
    63
neuper@37906
    64
(*------------------------------------------------------------------*)
neuper@37906
    65
structure interface : INTERFACE =
neuper@37906
    66
struct
neuper@37906
    67
(*------------------------------------------------------------------*)
neuper@37906
    68
neuper@38056
    69
(* encode "Isabelle"-strings as seen by the user to the
neuper@37906
    70
   format accepted by Isabelle.
neuper@37947
    71
   encode "^" ---> "^^^"; see Knowledge/Atools.thy;
neuper@37906
    72
   called for each cterm', icalhd, fmz in this interface;
neuper@38056
    73
   + see "fun decode" in xmlsrc/mathml.sml *)
neuper@38056
    74
fun encode (str : cterm') = 
neuper@37906
    75
    let fun enc [] = []
neuper@38056
    76
	  | enc ("^" :: cs) = "^" :: "^" :: "^" :: (enc cs)
neuper@38056
    77
	  | enc (c :: cs) = c :: (enc cs)
neuper@40836
    78
    in (implode o enc o Symbol.explode) str:cterm' end;
neuper@37906
    79
fun encode_imodel (imodel:imodel) =
neuper@37906
    80
    let fun enc (Given ifos) = Given (map encode ifos)
neuper@37906
    81
	  | enc (Find ifos) = Find (map encode ifos)
neuper@37906
    82
	  | enc (Relate ifos) = Relate (map encode ifos)
neuper@37906
    83
    in map enc imodel:imodel end;
neuper@37906
    84
fun encode_icalhd ((pos', headl, imodel, pos_, spec):icalhd) =
neuper@37906
    85
    (pos', encode headl, encode_imodel imodel, pos_, spec):icalhd;
neuper@38056
    86
fun encode_fmz ((ifos, spec) : fmz) = (map encode ifos, spec) : fmz;
neuper@37906
    87
neuper@37906
    88
neuper@37906
    89
(***. CalcTree .***)
neuper@37906
    90
neuper@37906
    91
(** add and delete users **)
neuper@37906
    92
neuper@37906
    93
(*.'Iterator 1' must exist with each CalcTree;
neuper@37906
    94
   the only for updating the calc-tree
neuper@37906
    95
   WN.0411: only 'Iterator 1' is stored,
neuper@37906
    96
   all others are just calculated on the fly
neuper@37906
    97
   TODO: adapt Iterator, add_user(= add_iterator!),etc. accordingly .*)
neuper@37906
    98
fun Iterator (cI:calcID) = (*returned ID unnecessary after WN.0411*)
neuper@37906
    99
    (adduserOK2xml cI (add_user (cI:calcID)))
neuper@37906
   100
    handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   101
fun IteratorTEST (cI:calcID) = add_user (cI:calcID);
neuper@37906
   102
(*fun DEconstructIterator (cI:calcID) (uI:iterID) =
neuper@37906
   103
    deluserOK2xml (del_user cI uI);*)
neuper@37906
   104
neuper@37906
   105
(*.create a calc-tree; for calls from java: thus ^^^ decoded to ^;
neuper@37906
   106
   compare "fun CalcTreeTEST" which does NOT decode.*)
neuper@38056
   107
fun CalcTree [(fmz, sp) : fmz] (*for several variants lateron*) =
neuper@37906
   108
	(let val cs = nxt_specify_init_calc (encode_fmz (fmz, sp))
neuper@37906
   109
	     (*FIXME.WN.8.03: error-handling missing*)
neuper@37906
   110
	     val cI = add_calc cs
neuper@37906
   111
	 in calctreeOK2xml cI end)
neuper@37906
   112
	handle _ => sysERROR2xml 0 "error in kernel";
neuper@37906
   113
neuper@37906
   114
fun DEconstrCalcTree (cI:calcID) =
neuper@37906
   115
    deconstructcalctreeOK2xml (del_calc cI);
neuper@37906
   116
neuper@37906
   117
neuper@37906
   118
fun getActiveFormula (cI:calcID) = iteratorOK2xml cI (get_pos cI 1);
neuper@37906
   119
neuper@37906
   120
fun moveActiveFormula (cI:calcID) (p:pos') =
neuper@37906
   121
    let val ((pt,_),_) = get_calc cI
neuper@37906
   122
    in if existpt' p pt then (upd_ipos cI 1 p; iteratorOK2xml cI p)
neuper@37906
   123
       else sysERROR2xml cI "frontend sends a non-existing pos" end;
neuper@37906
   124
neuper@37906
   125
(*. set the next tactic to be applied: dont't change the calc-tree,
neuper@37906
   126
    but remember the envisaged changes for fun autoCalculate;
neuper@37906
   127
    compare force NextTactic .*)
neuper@37906
   128
(* val (cI, tac) = (1, Add_Given "equality (x ^^^ 2 + 4 * x + 3 = 0)");
neuper@38058
   129
   val (cI, tac) = (1, Specify_Theory "PolyEq");
neuper@37906
   130
   val (cI, tac) = (1, Specify_Problem ["normalize","polynomial",
neuper@37906
   131
				   "univariate","equation"]);
neuper@38058
   132
   val (cI, tac) = (1, Subproblem ("Poly",
neuper@37906
   133
			      ["polynomial","univariate","equation"]));
neuper@37906
   134
   val (cI, tac) = (1, Model_Problem["linear","univariate","equation","test"]);
neuper@37906
   135
   val (cI, tac) = (1, Detail_Set "Test_simplify");
neuper@37906
   136
   val (cI, tac) = (1, Apply_Method ["Test", "solve_linear"]);
neuper@37906
   137
   val (cI, tac) = (1, Rewrite_Set "Test_simplify");
neuper@37906
   138
    *)
neuper@37906
   139
fun setNextTactic (cI:calcID) tac =
neuper@42129
   140
  let 
neuper@42129
   141
    val ((pt, _), _) = get_calc cI
neuper@42129
   142
	  val ip = get_pos cI 1
neuper@42129
   143
  in case locatetac tac (pt, ip) of
neuper@37906
   144
(* val ("ok", (tacis, c, (_,p'))) = locatetac tac (pt, ip);
neuper@37906
   145
   *)
neuper@37906
   146
	   ("ok", (tacis, _, _)) =>
neuper@37906
   147
	   (upd_calc cI ((pt, ip), tacis); setnexttactic2xml cI "ok")
neuper@37906
   148
	 | ("unsafe-ok", (tacis, _, _)) =>
neuper@37906
   149
	   (upd_calc cI ((pt, ip), tacis); setnexttactic2xml cI "unsafe-ok")
neuper@37906
   150
	 | ("not-applicable",_) => setnexttactic2xml cI "not-applicable"
neuper@37906
   151
	 | ("end-of-calculation",_) =>
neuper@37906
   152
	   setnexttactic2xml cI "end-of-calculation"
neuper@37906
   153
	 | ("failure",_) => sysERROR2xml cI "failure"
neuper@37906
   154
    end;
neuper@37906
   155
neuper@37906
   156
(*. apply a tactic at a position and update the calc-tree if applicable .*)
neuper@37947
   157
(*WN080226 java-code is missing, errors smltest/Knowledge/polyminus.sml*)
neuper@37906
   158
fun applyTactic (cI:calcID) ip tac =
neuper@42437
   159
  let
neuper@42437
   160
    val ((pt, _), _) = get_calc cI
neuper@42437
   161
	  val p = get_pos cI 1
neuper@42437
   162
  in 
neuper@42437
   163
    case locatetac tac (pt, ip) of
neuper@42437
   164
	    ("ok", (_, c, ptp as (_,p'))) =>
neuper@42437
   165
	      (upd_calc cI (ptp, []);
neuper@42437
   166
	       upd_ipos cI 1 p';
neuper@42437
   167
	       autocalculateOK2xml cI p (if null c then p' else last_elem c) p')
neuper@42437
   168
	  | ("unsafe-ok", (_, c, ptp as (_,p'))) =>
neuper@42437
   169
	      (upd_calc cI (ptp, []);
neuper@42437
   170
	       upd_ipos cI 1 p';
neuper@42437
   171
	       autocalculateOK2xml cI p (if null c then p' else last_elem c) p')
neuper@42437
   172
	  | ("end-of-calculation", (_, c, ptp as (_,p'))) =>
neuper@42437
   173
	      (upd_calc cI (ptp, []);
neuper@42437
   174
	       upd_ipos cI 1 p';
neuper@42437
   175
	       autocalculateOK2xml cI p (if null c then p' else last_elem c) p')
neuper@42437
   176
	  | (str,_) => autocalculateERROR2xml cI "failure"
neuper@42437
   177
  end;
neuper@37906
   178
neuper@37906
   179
fun fetchProposedTactic (cI:calcID) =
neuper@37906
   180
    (case step (get_pos cI 1) (get_calc cI) of
neuper@37906
   181
	   ("ok", (tacis, _, _)) =>
neuper@37906
   182
	   let val _= upd_tacis cI tacis
neuper@37906
   183
	       val (tac,_,_) = last_elem tacis
neuper@42458
   184
	   in fetchproposedtacticOK2xml cI tac (fetchErrorpatterns tac) end
neuper@37906
   185
	 | ("helpless",_) => fetchproposedtacticERROR2xml cI "helpless"
neuper@37906
   186
	 | ("no-fmz-spec",_) => fetchproposedtacticERROR2xml cI "no-fmz-spec"
neuper@37906
   187
	 | ("end-of-calculation",_) =>
neuper@37906
   188
	   fetchproposedtacticERROR2xml cI "end-of-calculation")
neuper@37906
   189
    handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   190
neuper@37906
   191
(*datatype auto = FIXXXME040624: does NOT match interfaces/ITOCalc.java
neuper@37906
   192
  Step of int      (*1 do #int steps (may stop in model/specify)
neuper@37906
   193
		     IS VERY INEFFICIENT IN MODEL/SPECIY*)
neuper@37906
   194
| CompleteModel    (*2 complete modeling
neuper@37906
   195
                     if model complete, finish specifying*)
neuper@37906
   196
| CompleteCalcHead (*3 complete model/specify in one go*)
neuper@37906
   197
| CompleteToSubpbl (*4 stop at the next begin of a subproblem,
neuper@37906
   198
                     if none, complete the actual (sub)problem*)
neuper@37906
   199
| CompleteSubpbl   (*5 complete the actual (sub)problem (incl.ev.subproblems)*)
neuper@37906
   200
| CompleteCalc;    (*6 complete the calculation as a whole*)*)
neuper@42412
   201
neuper@37906
   202
fun autoCalculate (cI:calcID) auto =
neuper@42412
   203
 (let
neuper@42412
   204
    val pold = get_pos cI 1
neuper@42412
   205
    val x = autocalc [] pold (get_calc cI) auto
neuper@42412
   206
  in
neuper@42412
   207
	  case x of
neuper@42412
   208
	    ("ok", c, ptp as (_,p)) =>
neuper@42412
   209
	      (upd_calc cI (ptp, []); upd_ipos cI 1 p;
neuper@42412
   210
	       autocalculateOK2xml cI pold (if null c then pold else last_elem c) p)
neuper@42412
   211
	  | ("end-of-calculation", c, ptp as (_,p)) =>
neuper@42412
   212
	      (upd_calc cI (ptp, []); upd_ipos cI 1 p;
neuper@42412
   213
	       autocalculateOK2xml cI pold (if null c then pold else last_elem c) p)
neuper@42412
   214
	  | (str, _, _) => autocalculateERROR2xml cI str
neuper@42412
   215
  end)
neuper@42412
   216
  handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   217
    
neuper@37906
   218
neuper@37906
   219
(* val (cI:calcID, ichd as ((p,_),_,_,_,_):icalhd) =
neuper@37906
   220
       (1, (([],Pbl), "not used here",
neuper@37906
   221
	[Given ["fixedValues [r=Arbfix]"],
neuper@37906
   222
	 Find ["maximum A", "valuesFor [a,b]"(*new input*)],
neuper@37906
   223
	 Relate ["relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]"]], Pbl,
neuper@38058
   224
       ("DiffApp", ["maximum_of","function"],
neuper@37906
   225
		   ["DiffApp","max_by_calculus"])));
neuper@37906
   226
 val (cI:calcID, ichd as ((p,_),_,_,_,_):icalhd) =
neuper@37906
   227
       (1, (([],Pbl),"solve (x+1=2, x)",
neuper@37906
   228
		  [Given ["equality (x+1=2)", "solveFor x"],
neuper@37906
   229
		   Find ["solutions L"]],
neuper@37906
   230
		  Pbl,
neuper@38058
   231
		  ("Test", ["linear","univariate","equation","test"],
neuper@37906
   232
		   ["Test","solve_linear"])));
neuper@37906
   233
 val (cI:calcID, ichd as ((p,_),_,_,_,_):icalhd) =
neuper@37906
   234
       (1, (([],Pbl),"solveTest (1+-1*2+x=0,x)", [], Pbl, ("", [], [])));
neuper@37906
   235
 val (cI, p:pos')=(1, ([1],Frm));
neuper@37906
   236
 val (cI, p:pos')=(1, ([1,2,1,3],Res)); 
neuper@37906
   237
   *)
neuper@37906
   238
fun getTactic cI (p:pos') =
neuper@37906
   239
    (let val ((pt,_),_) = get_calc cI
neuper@37906
   240
	 val (form, tac, asms) = pt_extract (pt, p)
neuper@37906
   241
    in case tac of
neuper@37926
   242
(* val SOME ta = tac;
neuper@37906
   243
   *)
neuper@37926
   244
	   SOME ta => gettacticOK2xml cI ta
neuper@37926
   245
	 | NONE => gettacticERROR2xml cI ("no tactic at position "^pos'2str p)
neuper@37906
   246
     end)
neuper@37906
   247
    handle _ => sysERROR2xml cI "syserror in getTactic";
neuper@37906
   248
neuper@37906
   249
(*. see ICalcIterator#fetchApplicableTactics
neuper@37906
   250
 @see #TACTICS_ALL
neuper@37906
   251
 @see #TACTICS_CURRENT_THEORY
neuper@37906
   252
 @see #TACTICS_CURRENT_METHOD  ..the only impl.WN040307.*)
neuper@37906
   253
(*. fetch tactics to be applied to a particular step.*)
neuper@37906
   254
(* WN071231 kept this version for later parametrisation*)
neuper@37906
   255
(*.version 1: fetch _all_ tactics from script .*)
neuper@37906
   256
fun fetchApplicableTactics cI (scope:int) (p:pos') =
neuper@37906
   257
    (let val ((pt, _), _) = get_calc cI
neuper@37906
   258
    in (applicabletacticsOK cI (sel_rules pt p))
neuper@37906
   259
       handle PTREE str => sysERROR2xml cI str 
neuper@37906
   260
     end)
neuper@37906
   261
    handle _ => sysERROR2xml cI "error in kernel";
neuper@42438
   262
(*WN120611 took version 1 again
neuper@42438
   263
  version 2: fetch _applicable_ _elementary_ (ie. recursively 
neuper@42438
   264
              decompose rule-sets) Rewrite*, Calculate
neuper@37906
   265
fun fetchApplicableTactics cI (scope:int) (p:pos') =
neuper@37906
   266
    (let val ((pt, _), _) = get_calc cI
neuper@37906
   267
    in (applicabletacticsOK cI (sel_appl_atomic_tacs pt p))
neuper@37906
   268
       handle PTREE str => sysERROR2xml cI str 
neuper@37906
   269
     end)
neuper@37906
   270
    handle _ => sysERROR2xml cI "error in kernel";
neuper@42438
   271
*)
neuper@37906
   272
fun getAssumptions cI (p:pos') =
neuper@37906
   273
    (let val ((pt,_),_) = get_calc cI
neuper@37906
   274
	 val (_, _, asms) = pt_extract (pt, p)
neuper@37906
   275
     in getasmsOK2xml cI asms end)
neuper@37906
   276
    handle _ => sysERROR2xml cI "syserror in getAssumptions";
neuper@37906
   277
neuper@37906
   278
(*WN0502 @see ME/ctree: type asms: illdesigned, thus no positions returned*)
neuper@37906
   279
fun getAccumulatedAsms cI (p:pos') =
neuper@37906
   280
    (let val ((pt, _), _) = get_calc cI
e0726734@41957
   281
	 val ass = get_assumptions_ pt p
neuper@37906
   282
     in (*getaccuasmsOK2xml cI (get_assumptions_ pt p)*)
neuper@37906
   283
     getasmsOK2xml cI ass end)
neuper@37906
   284
    handle _ => sysERROR2xml cI "syserror in getAccumulatedAsms";
neuper@37906
   285
neuper@37906
   286
neuper@37906
   287
(*since moveActive* does NOT transfer pos java --> sml (only sml --> java)
neuper@37906
   288
  refFormula might become involved in far-off errors !!!*)
neuper@37906
   289
fun refFormula cI (p:pos') = (*WN0501 rename to 'fun getElement' !*)
neuper@37906
   290
(* val (cI, uI) = (1,1);
neuper@37906
   291
   *)
neuper@37906
   292
    (let val ((pt,_),_) = get_calc cI
neuper@37906
   293
	 val (form, tac, asms) = pt_extract (pt, p)
neuper@37906
   294
    in refformulaOK2xml cI p form end)
neuper@37906
   295
    handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   296
neuper@37906
   297
(*.get formulae 'from' 'to' w.r.t. ordering in Position#compareTo(Position p); 
neuper@37906
   298
   in case of CalcHeads only the headline is taken
neuper@37906
   299
   (the pos' allows distinction between PrfObj and PblObj anyway);
neuper@37906
   300
   'level' is adjusted such that an 'interval' of formulae is returned;
neuper@37906
   301
   'from' 'to' are designed for use by iterators of calcChangedEvent;
neuper@37906
   302
   thus 'from' is the last unchanged position.*)
neuper@37906
   303
fun getFormulaeFromTo cI (from as ([],Pbl):pos') (to as ([],Pbl):pos')_ false =
neuper@37906
   304
(*special case because 'from' is _before_ the first elements to be returned*)
neuper@37906
   305
(* val (cI, from, to, level) = (1, ([],Pbl), ([],Pbl), 1);
neuper@37906
   306
   *)
neuper@37906
   307
    ((let val ((pt,_),_) = get_calc cI
neuper@37906
   308
	val (ModSpec (_,_,headline,_,_,_),_,_) = pt_extract (pt, to)
neuper@37906
   309
    in getintervalOK cI [(to, headline)] end)
neuper@37906
   310
    handle _ => sysERROR2xml cI "error in kernel")
neuper@37906
   311
neuper@37906
   312
  | getFormulaeFromTo cI (from as ([],Pbl):pos') (to as ([],Met):pos')_ false =
neuper@37906
   313
    getFormulaeFromTo cI ([],Pbl) ([],Pbl) (~00000) false
neuper@37906
   314
neuper@37906
   315
  | getFormulaeFromTo cI (from:pos') (to:pos') level false =
neuper@37906
   316
(* val (cI, from, to, level) = (1, unc, gen, 0);
neuper@37906
   317
   val (cI, from, to, level) = (1, unc, gen, 1);
neuper@37906
   318
   val (cI, from, to, level) = (1, ([],Pbl), ([],Met), 1);
neuper@37906
   319
   *)
neuper@37906
   320
    (if from = to then sysERROR2xml cI "getFormulaeFromTo: From = To"
neuper@37906
   321
     else
neuper@37906
   322
	 (case from of
neuper@37906
   323
	      ([],Res) => sysERROR2xml cI "getFormulaeFromTo does: moveDown \
neuper@37906
   324
					  \from=([],Res) .. goes beyond result"
neuper@37906
   325
	    | _ => let val ((pt,_),_) = get_calc cI
neuper@37906
   326
		       val f = move_dn [] pt from
neuper@37906
   327
		       fun max (a,b) = if a < b then b else a
neuper@37906
   328
		       (*must reach margins ...*)
neuper@37906
   329
		       val lev = max (level, max (lev_of from, lev_of to))
neuper@37906
   330
		   in getintervalOK cI (get_interval f to lev pt) end)
neuper@37906
   331
	 handle _ => sysERROR2xml cI "error in getFormulaeFromTo")
neuper@37906
   332
neuper@37906
   333
  | getFormulaeFromTo cI from to level true =
neuper@37906
   334
    sysERROR2xml cI "getFormulaeFromTo impl.for formulae only,\
neuper@37906
   335
		    \i.e. last arg only impl. for false, _NOT_ true";
neuper@37906
   336
neuper@37906
   337
neuper@37906
   338
(* val (cI, ip) = (1, ([1,9], Res));
neuper@37906
   339
   val (cI, ip) = (1, ([], Res));
neuper@37906
   340
   val (cI, ip) = (1, ([2], Res));
neuper@37906
   341
   val (cI, ip) = (1, ([3,1], Res));
neuper@37906
   342
   val (cI, ip) = (1, ([1,2,1], Res));
neuper@37906
   343
   *)
neuper@37906
   344
fun interSteps cI ip =
neuper@37906
   345
    (let val ((pt,p), tacis) = get_calc cI
neuper@37906
   346
     in if (not o is_interpos) ip
neuper@37906
   347
	then interStepsERROR cI "only formulae with position (_,Res) \
neuper@37906
   348
				\may have intermediate steps above them"
neuper@37906
   349
	else let val ip' = lev_pred' pt ip
neuper@37906
   350
(* val (str, pt', lastpos) = detailstep pt ip;
neuper@37906
   351
   *)
neuper@37906
   352
	     in case detailstep pt ip of
neuper@37906
   353
		    ("detailrls", pt(*, pos'forms*), lastpos) =>
neuper@37906
   354
		    (upd_calc cI ((pt, p), tacis);
neuper@37906
   355
		     interStepsOK cI (*pos'forms*) ip' ip' lastpos)
neuper@37906
   356
		  | ("no-Rewrite_Set...", _, _) =>
neuper@37906
   357
		    sysERROR2xml cI "no Rewrite_Set..."
neuper@37906
   358
		  | (_, _(*, pos'formshds*), lastpos) =>
neuper@37906
   359
		    interStepsOK cI (*pos'formshds*) ip' ip' lastpos
neuper@37906
   360
	     end
neuper@37906
   361
     end)
neuper@37906
   362
    handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   363
neuper@37906
   364
fun modifyCalcHead (cI:calcID) (ichd as ((p,_),_,_,_,_):icalhd) =
neuper@37906
   365
    (let val ((pt,_),_) = get_calc cI
neuper@37906
   366
	val (pt, chd as (_,p_,_,_,_,_)) = input_icalhd pt ichd
neuper@37906
   367
    in (upd_calc cI ((pt, (p,p_)), []); 
neuper@37906
   368
	modifycalcheadOK2xml cI chd) end)
neuper@37906
   369
    handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   370
neuper@37906
   371
(*.at the activeFormula set the Model, the Guard and the Specification 
neuper@37906
   372
   to empty and return a CalcHead;
neuper@37906
   373
   the 'origin' remains (for reconstructing all that).*)
neuper@37906
   374
fun resetCalcHead (cI:calcID) = 
neuper@37906
   375
    (let val (ptp,_) = get_calc cI
neuper@37906
   376
	val ptp = reset_calchead ptp
neuper@37906
   377
    in (upd_calc cI (ptp, []); 
neuper@37906
   378
	modifycalcheadOK2xml cI (get_ocalhd ptp)) end)
neuper@37906
   379
    handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   380
neuper@37906
   381
(*.at the activeFormula insert all the Descriptions in the Model 
neuper@37906
   382
   (_not_ in the Guard) and return a CalcHead;
neuper@37906
   383
   the Descriptions are for user-guidance; the rest of the items 
neuper@37906
   384
   are left empty for user-input; 
neuper@37906
   385
   includes a resetCalcHead for the Model and the Guard.*)
neuper@37906
   386
fun modelProblem (cI:calcID) = 
neuper@37906
   387
    (let val (ptp, _) = get_calc cI
neuper@37906
   388
	val ptp = reset_calchead ptp
neuper@37906
   389
	val (_, _, ptp) = nxt_specif Model_Problem ptp
neuper@37906
   390
    in (upd_calc cI (ptp, []); 
neuper@37906
   391
	modifycalcheadOK2xml cI (get_ocalhd ptp)) end)
neuper@37906
   392
    handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   393
neuper@37906
   394
neuper@41993
   395
(* set the UContext determined on a knowledgebrowser to the current calc *)
neuper@37906
   396
fun setContext (cI:calcID) (ip as (_,p_):pos') (guh:guh) =
neuper@41993
   397
  (case (implode o (take_fromto 1 4) o Symbol.explode) guh of 
neuper@41993
   398
     "thy_" =>
neuper@41993
   399
	     if member op = [Pbl,Met] p_
neuper@41993
   400
       then message2xml cI "thy-context not to calchead"
neuper@41993
   401
       else if ip = ([],Res) then message2xml cI "no thy-context at result"
neuper@41993
   402
	     else if no_thycontext guh then message2xml cI ("no thy-context for '" ^ guh ^ "'")
neuper@41993
   403
  	   else 
neuper@41993
   404
         let
neuper@41993
   405
           val (ptp as (pt, pold), _) = get_calc cI
neuper@41993
   406
		       val is = get_istate pt ip
neuper@41993
   407
		       val subs = subs_from is "dummy" guh
neuper@41993
   408
		       val tac = guh2rewtac guh subs
neuper@41993
   409
  	     in 
neuper@41993
   410
           case locatetac tac (pt, ip) of (*='fun setNextTactic'+step*)
neuper@41993
   411
		         ("ok", (tacis, c, ptp as (_,p))) =>
neuper@41993
   412
		           (upd_calc cI ((pt,p), []); 
neuper@41993
   413
		            autocalculateOK2xml cI pold (if null c then pold else last_elem c) p)
neuper@41993
   414
		       | ("unsafe-ok", (tacis, c, ptp as (_,p))) =>
neuper@41993
   415
  		         (upd_calc cI ((pt,p), []); 
neuper@41993
   416
	  	          autocalculateOK2xml cI pold (if null c then pold else last_elem c) p)
neuper@41993
   417
		       | ("end-of-calculation",_) => message2xml cI "end-of-calculation"
neuper@41993
   418
		       | ("failure",_) => sysERROR2xml cI "failure"
neuper@41993
   419
		       | ("not-applicable",_) => (*the rule comes from anywhere..*)
neuper@41993
   420
		           (case applicable_in ip pt tac of 
neuper@41993
   421
		              Notappl e => message2xml cI ("'" ^ tac2str tac ^ "' not-applicable")
neuper@41993
   422
	              | Appl m => 
neuper@41993
   423
		                let
neuper@42002
   424
                      val ctxt = get_ctxt pt pold
neuper@41993
   425
                      val (p,c,_,pt) =
neuper@42002
   426
                        generate1 (assoc_thy "Isac") m (Uistate, ctxt) ip pt
neuper@41993
   427
                    in upd_calc cI ((pt,p),[]);
neuper@41993
   428
	                  autocalculateOK2xml cI pold (if null c then pold else last_elem c) p
neuper@41993
   429
		  	            end)
neuper@41993
   430
	       end
neuper@41993
   431
   | "pbl_" =>
neuper@41993
   432
	     let
neuper@41993
   433
         val pI = guh2kestoreID guh
neuper@41993
   434
	       val ((pt, _), _) = get_calc cI
neuper@41993
   435
	       in
neuper@41993
   436
           if member op = [Pbl, Met] p_ 
neuper@41993
   437
	         then
neuper@41993
   438
             let val (pt, chd) = set_problem pI (pt, ip)
neuper@41993
   439
		         in (upd_calc cI ((pt, ip), []); modifycalcheadOK2xml cI chd) end
neuper@41993
   440
	         else sysERROR2xml cI "setContext for pbl requires ActiveFormula on CalcHead"
neuper@41993
   441
	     end
neuper@41993
   442
   | "met_" =>
neuper@41993
   443
	     let
neuper@41993
   444
         val mI = guh2kestoreID guh
neuper@41993
   445
	       val ((pt, _), _) = get_calc cI
neuper@41993
   446
	       in
neuper@41993
   447
           if member op = [Pbl, Met] p_
neuper@41993
   448
	         then
neuper@41993
   449
             let val (pt, chd) = set_method mI (pt, ip)
neuper@41993
   450
		         in (upd_calc cI ((pt, ip), []); modifycalcheadOK2xml cI chd) end
neuper@41993
   451
	         else sysERROR2xml cI "setContext for met requires ActiveFormula on CalcHead"
neuper@41993
   452
	       end)
neuper@41993
   453
   handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   454
neuper@37906
   455
neuper@37906
   456
(*.specify the Method at the activeFormula and return a CalcHead
neuper@37906
   457
   containing the Guard.
neuper@37906
   458
   WN0512 impl.incomplete, see 'nxt_specif (Specify_Method '.*)
neuper@37906
   459
fun setMethod (cI:calcID) (mI:metID) = 
neuper@37906
   460
(* val (cI, mI) = (1, ["Test","solve_linear"]);
neuper@37906
   461
   *)
neuper@37906
   462
    (let val ((pt, _), _) = get_calc cI
neuper@37906
   463
	val ip as (_, p_) = get_pos cI 1
neuper@37935
   464
    in if member op = [Pbl,Met] p_ 
neuper@37906
   465
       then let val (pt, chd) = set_method mI (pt, ip)
neuper@37906
   466
	    in (upd_calc cI ((pt, ip), []);
neuper@37906
   467
		modifycalcheadOK2xml cI chd) end
neuper@37906
   468
       else sysERROR2xml cI "setMethod requires ActiveFormula on CalcHead"
neuper@37906
   469
 end)
neuper@37906
   470
    handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   471
neuper@37906
   472
(*.specify the Problem at the activeFormula and return a CalcHead
neuper@37906
   473
   containing the Model; special case of checkContext;
neuper@37906
   474
   WN0512 impl.incomplete, see 'nxt_specif (Specify_Problem '.*)
neuper@37906
   475
fun setProblem (cI:calcID) (pI:pblID) =
neuper@37906
   476
    (let val ((pt, _), _) = get_calc cI
neuper@37906
   477
	val ip as (_, p_) = get_pos cI 1
neuper@37935
   478
    in if member op = [Pbl,Met] p_
neuper@37906
   479
       then let val (pt, chd) = set_problem pI (pt, ip)
neuper@37906
   480
	    in (upd_calc cI ((pt, ip), []);
neuper@37906
   481
		modifycalcheadOK2xml cI chd) end
neuper@37906
   482
       else sysERROR2xml cI "setProblem requires ActiveFormula on CalcHead"
neuper@37906
   483
 end)
neuper@37906
   484
    handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   485
neuper@37906
   486
(*.specify the Theory at the activeFormula and return a CalcHead;
neuper@37906
   487
   special case of checkContext;
neuper@37906
   488
   WN0512 impl.incomplete, see 'nxt_specif (Specify_Method '.*)
neuper@37906
   489
fun setTheory (cI:calcID) (tI:thyID) =
neuper@37906
   490
    (let val ((pt, _), _) = get_calc cI
neuper@37906
   491
	val ip as (_, p_) = get_pos cI 1
neuper@37935
   492
    in if member op = [Pbl,Met] p_
neuper@37906
   493
       then let val (pt, chd) = set_theory tI (pt, ip)
neuper@37906
   494
	    in (upd_calc cI ((pt, ip), []);
neuper@37906
   495
		modifycalcheadOK2xml cI chd) end
neuper@37906
   496
       else sysERROR2xml cI "setProblem requires ActiveFormula on CalcHead"
neuper@37906
   497
 end)
neuper@37906
   498
    handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   499
neuper@37906
   500
neuper@37906
   501
(**. without update of CalcTree .**)
neuper@37906
   502
neuper@37906
   503
(*.match the model of a problem at pos p 
neuper@37906
   504
   with the model-pattern of the problem with pblID*)
neuper@37906
   505
(*fun tryMatchProblem cI pblID =
neuper@37906
   506
    (let val ((pt,_),_) = get_calc cI
neuper@37906
   507
	 val p = get_pos cI 1
neuper@37906
   508
	 val chd = trymatch pblID pt p
neuper@37906
   509
    in trymatchOK2xml cI chd end)
neuper@37906
   510
    handle _ => sysERROR2xml cI "error in kernel";*)
neuper@37906
   511
neuper@37906
   512
(*.refinement for the parent-problem of the position.*)
neuper@37906
   513
(* val (cI, (p,p_), guh) = (1, ([1],Res), "pbl_equ_univ");
neuper@37906
   514
   *)
neuper@37906
   515
fun refineProblem cI ((p,p_) : pos') (guh : guh) =
neuper@37906
   516
    (let val pblID = guh2kestoreID guh
neuper@37906
   517
	 val ((pt,_),_) = get_calc cI
neuper@37906
   518
	 val pp = par_pblobj pt p
neuper@37906
   519
	 val chd = tryrefine pblID pt (pp, p_)
neuper@37906
   520
    in matchpbl2xml cI chd end)
neuper@37906
   521
    handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   522
neuper@42423
   523
(* append a formula to the calculation *)
neuper@37906
   524
fun appendFormula cI (ifo:cterm') =
neuper@42423
   525
  (let
neuper@42423
   526
    val cs = get_calc cI
neuper@42423
   527
    val pos as (_,p_) = get_pos cI 1
neuper@42423
   528
  in
neuper@42423
   529
    case step pos cs of
neuper@37906
   530
	    ("ok", cs') =>
neuper@42423
   531
	      (case inform cs' (encode ifo) of
neuper@42423
   532
	        ("ok", (_(*use in DG !!!*), c, ptp as (_,p))) =>
neuper@42423
   533
	          (upd_calc cI (ptp, []); upd_ipos cI 1 p;
neuper@42423
   534
	          appendformulaOK2xml cI pos (if null c then pos else last_elem c) p)
neuper@42423
   535
	      | ("same-formula", (_, c, ptp as (_,p))) =>
neuper@42423
   536
	          (upd_calc cI (ptp, []); upd_ipos cI 1 p;
neuper@42423
   537
	          appendformulaOK2xml cI pos (if null c then pos else last_elem c) p)
neuper@42423
   538
	      | (msg, _) => appendformulaERROR2xml cI msg)
neuper@37906
   539
	  | (msg, cs') => appendformulaERROR2xml cI msg
neuper@42423
   540
  end)
neuper@42423
   541
  handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   542
neuper@38056
   543
(* replace a formula with_in_ a calculation;
neuper@38056
   544
   this situation applies for initial CAS-commands, too *)
neuper@37906
   545
fun replaceFormula cI (ifo:cterm') =
neuper@42437
   546
 (let
neuper@42437
   547
    val ((pt, _), _) = get_calc cI
neuper@42437
   548
    val p = get_pos cI 1
neuper@42437
   549
  in
neuper@42437
   550
    case inform (([], [], (pt, p)): calcstate') (encode ifo) of
neuper@42437
   551
	    ("ok", (_(*tacs used for DG ?*), c, ptp' as (pt',p'))) =>
neuper@42437
   552
	      let
neuper@42437
   553
	        val unc = if null (fst p) then p else move_up [] pt p
neuper@42437
   554
	        val _ = upd_calc cI (ptp', [])
neuper@42437
   555
	        val _ = upd_ipos cI 1 p'
neuper@42437
   556
	      in replaceformulaOK2xml cI unc (if null c then unc else last_elem c) p' end
neuper@42437
   557
	  | ("same-formula", _) => replaceformulaERROR2xml cI "formula not changed"
neuper@42437
   558
	  | (msg, _) => replaceformulaERROR2xml cI msg
neuper@42437
   559
  end)
neuper@37906
   560
    handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   561
neuper@37906
   562
neuper@37906
   563
neuper@37906
   564
(***. CalcIterator
neuper@37906
   565
    moveActive*: set the pos' of the active formula stored with the calctree
neuper@37906
   566
                 could take pos' as argument for consistency checks
neuper@37906
   567
    move*:       compute the new iterator from the old one on the fly
neuper@37906
   568
neuper@37906
   569
.***)
neuper@37906
   570
neuper@37906
   571
fun moveActiveRoot cI =
neuper@37906
   572
    (let val _ = upd_ipos cI 1 ([],Pbl)
neuper@37906
   573
    in iteratorOK2xml cI ([],Pbl) end)
neuper@37906
   574
    handle e => sysERROR2xml cI "error in kernel";
neuper@37906
   575
fun moveRoot cI =
neuper@37906
   576
    (iteratorOK2xml cI ([],Pbl))
neuper@37906
   577
    handle e => sysERROR2xml cI "";
neuper@37906
   578
fun moveActiveRootTEST cI =
neuper@37906
   579
    (let val _ = upd_ipos cI 1 ([],Pbl)
neuper@37906
   580
    in (*iteratorOK2xml cI ([],Pbl)*)() end)
neuper@37906
   581
    handle e => sysERROR2xml cI "error in kernel";
neuper@37906
   582
neuper@37906
   583
(* val (cI, uI) = (1,1);
neuper@37906
   584
   val (cI, uI) = (1,2);
neuper@37906
   585
   *)
neuper@37906
   586
fun moveActiveDown cI =
neuper@37906
   587
    ((let val ((pt,_),_) = get_calc cI
neuper@37906
   588
(* val (P, (Nd (_, ns)), (p::(ps as (_::_)), p_)) =([]:pos, pt, get_pos cI uI);
neuper@37906
   589
   val (P, (Nd (c, ns)), ([p], p_))               =([]:pos, pt, get_pos cI uI);
neuper@37906
   590
neuper@37906
   591
   print_depth 7;pt
neuper@37906
   592
   *)
neuper@37906
   593
	  val ip' = move_dn [] pt (get_pos cI 1)
neuper@37906
   594
	  val _ = upd_ipos cI 1 ip'
neuper@37906
   595
      in iteratorOK2xml cI ip' end)
neuper@37906
   596
     handle (PTREE e) => iteratorERROR2xml cI)
neuper@37906
   597
    handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   598
fun moveDown cI (p:pos') =
neuper@37906
   599
    ((let val ((pt,_),_) = get_calc cI
neuper@37906
   600
(* val (P, (Nd (_, ns)), (p::(ps as (_::_)), p_)) =([]:pos, pt, get_pos cI uI);
neuper@37906
   601
   val (P, (Nd (c, ns)), ([p], p_))               =([]:pos, pt, get_pos cI uI);
neuper@37906
   602
neuper@37906
   603
   print_depth 7;pt
neuper@37906
   604
   *)
neuper@37906
   605
	  val ip' = move_dn [] pt p
neuper@37906
   606
      in iteratorOK2xml cI ip' end)
neuper@37906
   607
     handle (PTREE e) => iteratorERROR2xml cI)
neuper@37906
   608
    handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   609
fun moveActiveDownTEST cI =
neuper@37906
   610
    let val ((pt,_),_) = get_calc cI
neuper@37906
   611
	val ip = get_pos cI 1
neuper@37906
   612
	  val ip' = (move_dn [] pt ip)
neuper@37906
   613
	      handle _ => ip
neuper@37906
   614
	  val _ = upd_ipos cI 1 ip'
neuper@37906
   615
      in (*iteratorOK2xml cI uI*)() end;
neuper@37906
   616
neuper@37906
   617
fun moveActiveLevelDown cI =
neuper@37906
   618
    ((let val ((pt,_),_) = get_calc cI
neuper@37906
   619
	  val ip' = movelevel_dn [] pt (get_pos cI 1)
neuper@37906
   620
	  val _ = upd_ipos cI 1 ip'
neuper@37906
   621
      in iteratorOK2xml cI ip' end)
neuper@37906
   622
     handle (PTREE e) => iteratorERROR2xml cI)
neuper@37906
   623
    handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   624
fun moveLevelDown cI (p:pos') =
neuper@37906
   625
    ((let val ((pt,_),_) = get_calc cI
neuper@37906
   626
	  val ip' = movelevel_dn [] pt p
neuper@37906
   627
      in iteratorOK2xml cI ip' end)
neuper@37906
   628
     handle (PTREE e) => iteratorERROR2xml cI)
neuper@37906
   629
    handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   630
neuper@37906
   631
fun moveActiveUp cI =
neuper@37906
   632
    ((let val ((pt,_),_) = get_calc cI
neuper@37906
   633
	  val ip' = move_up [] pt (get_pos cI 1)
neuper@37906
   634
	  val _ = upd_ipos cI 1 ip'
neuper@37906
   635
      in iteratorOK2xml cI ip' end)
neuper@37906
   636
     handle PTREE e => iteratorERROR2xml cI)
neuper@37906
   637
    handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   638
fun moveUp cI (p:pos') =
neuper@37906
   639
    ((let val ((pt,_),_) = get_calc cI
neuper@37906
   640
	  val ip' = move_up [] pt p
neuper@37906
   641
      in iteratorOK2xml cI ip' end)
neuper@37906
   642
     handle PTREE e => iteratorERROR2xml cI)
neuper@37906
   643
    handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   644
neuper@37906
   645
fun moveActiveLevelUp cI =
neuper@37906
   646
    ((let val ((pt,_),_) = get_calc cI
neuper@37906
   647
	  val ip' = movelevel_up [] pt (get_pos cI 1)
neuper@37906
   648
	  val _ = upd_ipos cI 1 ip'
neuper@37906
   649
      in iteratorOK2xml cI ip' end)
neuper@37906
   650
     handle PTREE e => iteratorERROR2xml cI)
neuper@37906
   651
    handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   652
fun moveLevelUp cI (p:pos') =
neuper@37906
   653
    ((let val ((pt,_),_) = get_calc cI
neuper@37906
   654
	  val ip' = movelevel_up [] pt p
neuper@37906
   655
      in iteratorOK2xml cI ip' end)
neuper@37906
   656
     handle PTREE e => iteratorERROR2xml cI)
neuper@37906
   657
    handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   658
neuper@37906
   659
fun moveActiveCalcHead cI =
neuper@37906
   660
    ((let val ((pt,_),_) = get_calc cI
neuper@37906
   661
	  val ip' = movecalchd_up pt (get_pos cI 1)
neuper@37906
   662
	  val _ = upd_ipos cI 1 ip'
neuper@37906
   663
      in iteratorOK2xml cI ip' end)
neuper@37906
   664
     handle PTREE e => iteratorERROR2xml cI)
neuper@37906
   665
    handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   666
fun moveCalcHead cI (p:pos') =
neuper@37906
   667
    ((let val ((pt,_),_) = get_calc cI
neuper@37906
   668
	  val ip' = movecalchd_up pt p
neuper@37906
   669
      in iteratorOK2xml cI ip' end)
neuper@37906
   670
     handle PTREE e => iteratorERROR2xml cI)
neuper@37906
   671
    handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   672
neuper@37906
   673
neuper@37906
   674
(*.initContext Thy_ is conceptually impossible at [Pbl,Met] 
neuper@37906
   675
   and at positions with Check_Postcond and End_Trans;
neuper@37906
   676
   at possible pos's there can be NO rewrite (returned as a context, too).*)
neuper@37906
   677
(* val (cI, Thy_, (pos as (p,p_):pos')) = (1, Thy_, ([1], Frm));
neuper@37906
   678
   val (cI, Thy_, (pos as (p,p_):pos')) = (1, Thy_, ([], Res));
neuper@37906
   679
   val (cI, Thy_, (pos as (p,p_):pos')) = (1, Thy_, ([2], Res));
neuper@37906
   680
   val (cI, Thy_, (pos as (p,p_):pos')) = (1, Thy_, ([1,1], Frm));
neuper@37906
   681
   *)
neuper@37906
   682
fun initContext (cI:calcID) Thy_ (pos as (p,p_):pos') =
neuper@37935
   683
    ((if member op = [Pbl,Met] p_
neuper@37930
   684
      then message2xml cI "thy-context not to calchead"
neuper@37906
   685
      else if pos = ([],Res) then message2xml cI "no thy-context at result"
neuper@37906
   686
      else let val cs as (ptp as (pt,_),_) = get_calc cI
neuper@37906
   687
	   in if exist_lev_on' pt pos
neuper@37906
   688
	      then let val pos' = lev_on' pt pos
neuper@37906
   689
		       val tac = get_tac_checked pt pos'
neuper@37906
   690
		   in if is_rewtac tac 
neuper@37906
   691
		      then contextthyOK2xml cI (context_thy (pt,pos) tac)
neuper@37906
   692
		      else message2xml cI ("no thy-context at tac '" ^
neuper@37906
   693
					   tac2str tac ^ "'")
neuper@37906
   694
		   end
neuper@37906
   695
	      else if is_curr_endof_calc pt pos
neuper@37906
   696
	      then case step pos cs of
neuper@37906
   697
(* val (str, (tacis, _, (pt,_))) = step pos cs;
neuper@37906
   698
   val ("ok", (tacis, _, (pt,_))) = step pos cs;
neuper@37906
   699
   *)
neuper@37906
   700
		       ("ok", (tacis, _, (pt,_))) =>
neuper@37906
   701
		       let val tac = fst3 (last_elem tacis)
neuper@37906
   702
		       in if is_rewtac tac 
neuper@37906
   703
			  then contextthyOK2xml 
neuper@37906
   704
				   cI (context_thy ptp tac)
neuper@37906
   705
			  else message2xml cI ("no thy-context at tac '" ^
neuper@37906
   706
					       tac2str tac ^ "'")
neuper@37906
   707
		       end
neuper@37906
   708
		     | (msg, _) => message2xml cI msg
neuper@37906
   709
	      else message2xml cI "no thy-context at this position"
neuper@37906
   710
	   end)
neuper@37906
   711
     handle _ => sysERROR2xml cI "error in kernel")
neuper@37906
   712
neuper@37906
   713
(* val (cI, Pbl_, pos as (p,p_)) = (1, Pbl_, ([],Pbl));
neuper@37906
   714
   *)
neuper@37906
   715
  | initContext cI Pbl_ (pos as (p,p_):pos') = 
neuper@37906
   716
    ((let val ((pt,_),_) = get_calc cI
neuper@37906
   717
	  val pp = par_pblobj pt p
neuper@37906
   718
	  val chd = initcontext_pbl pt (pp,p_)
neuper@37906
   719
      in matchpbl2xml cI chd end)
neuper@37906
   720
     handle _ => sysERROR2xml cI "error in kernel")
neuper@37906
   721
neuper@37906
   722
  | initContext cI Met_ (pos as (p,p_):pos') =
neuper@37906
   723
    ((let val ((pt,_),_) = get_calc cI
neuper@37906
   724
	  val pp = par_pblobj pt p
neuper@37906
   725
	  val chd = initcontext_met pt (pp,p_)
neuper@37906
   726
      in matchmet2xml cI chd end)
neuper@37906
   727
     handle _ => sysERROR2xml cI "error in kernel");
neuper@37906
   728
neuper@42430
   729
(* match a theorem, a ruleset (etc., selected in the knowledge-browser)
neuper@42430
   730
  with the formula in the focus on the worksheet;
neuper@42430
   731
  string contains the thy, thus it is unique as thmID, rlsID for this thy;
neuper@42430
   732
  take the substitution from the istate of the formula *)
neuper@37947
   733
(* use"../smltest/Knowledge/poly.sml";
neuper@42430
   734
   val (cI, pos as (p,p_), guh) = (1, ([1,1,1], Frm), "thy_Poly-thm-real_diff_minus");
neuper@37906
   735
   val (cI, pos as (p,p_), guh) = (1, ([1,1], Frm), "norm_Poly");
neuper@42430
   736
   val (cI, pos as (p,p_), guh) = (1, ([1], Res), "thy_isac_Test-rls-Test_simplify");
neuper@37906
   737
   *)
neuper@37906
   738
fun checkContext (cI:calcID) (pos:pos' as (p,p_)) (guh:guh) =
neuper@40836
   739
    (case (implode o (take_fromto 1 4) o Symbol.explode) guh of
neuper@37906
   740
	 "thy_" =>
neuper@37935
   741
	 if member op = [Pbl,Met] p_
neuper@37930
   742
         then message2xml cI "thy-context not to calchead"
neuper@37906
   743
	 else if pos = ([],Res) then message2xml cI "no thy-context at result"
neuper@37906
   744
	 else if no_thycontext guh then message2xml cI ("no thy-context for '"^
neuper@37906
   745
							guh ^ "'")
neuper@37906
   746
	 else let val (ptp as (pt,_),_) = get_calc cI
bonzai@41953
   747
		  val is = get_istate pt pos
neuper@37906
   748
		  val subs = subs_from is "dummy" guh
neuper@37906
   749
		  val tac = guh2rewtac guh subs
neuper@37906
   750
	      in contextthyOK2xml cI (context_thy (pt, pos) tac) end
neuper@37906
   751
		  
neuper@37906
   752
       (*.match the model of a problem at pos p 
neuper@37906
   753
          with the model-pattern of the problem with pblID.*)
neuper@37906
   754
(* val (cI, pos:pos' as (p,p_), guh) =
neuper@37906
   755
       (1, p, kestoreID2guh Pbl_ ["univariate","equation"]);
neuper@37906
   756
   val (cI, pos:pos' as (p,p_), guh) =
neuper@37906
   757
       (1, ([],Pbl), kestoreID2guh Pbl_ ["univariate","equation"]);
neuper@37906
   758
   val (cI, pos:pos' as (p,p_), guh) =
neuper@37906
   759
       (1, ([],Pbl), "pbl_equ_univ");
neuper@37906
   760
   *)
neuper@37906
   761
       | "pbl_" => 
neuper@37906
   762
	 let val ((pt,_),_) = get_calc cI
neuper@37906
   763
	     val pp = par_pblobj pt p
neuper@37906
   764
	     val keID = guh2kestoreID guh
neuper@37906
   765
	     val chd = context_pbl keID pt pp
neuper@37906
   766
	 in matchpbl2xml cI chd end
neuper@37906
   767
(* val (cI, pos:pos' as (p,p_), guh) = 
neuper@37906
   768
       (1, ([],Pbl), kestoreID2guh Met_ ["LinEq", "solve_lineq_equation"]);
neuper@37906
   769
   *)
neuper@37906
   770
       | "met_" => 
neuper@37906
   771
	 let val ((pt,_),_) = get_calc cI
neuper@37906
   772
	     val pp = par_pblobj pt p
neuper@37906
   773
	     val keID = guh2kestoreID guh
neuper@37906
   774
	     val chd = context_met keID pt pp
neuper@37906
   775
	 in matchmet2xml cI chd end)
neuper@37906
   776
    handle _ => sysERROR2xml cI "error in kernel";
neuper@37906
   777
neuper@42430
   778
(* for an errpatID find "(fillpatID, fillform)" list 
neuper@42430
   779
  which dedicated to this errpat and which is applicable at current formula*)
neuper@42433
   780
fun findFillpatterns cI errpatID = 
neuper@42430
   781
  let
neuper@42430
   782
    val ((pt, _), _) = get_calc cI
neuper@42433
   783
		    val pos = get_pos cI 1;
neuper@42433
   784
		    val fillpats = find_fillpatterns (pt, pos) errpatID
neuper@42450
   785
			  in findFillpatterns2xml cI (map #1 fillpats) end;
neuper@42432
   786
neuper@42432
   787
(* given a fillpatID propose a fillform to the learner on the worksheet;
neuper@42433
   788
  the "ctree" is extended with fillpat and "ostate Inconsistent",
neuper@42433
   789
  the "istate" is copied and NOT updated;
neuper@42432
   790
  returns CalcChanged.
neuper@42432
   791
  arg errpatID: required because there is no dialog-related state in the math-kernel.
neuper@42432
   792
*)
neuper@42432
   793
fun requestFillformula cI (errpatID, fillpatID) =
neuper@42432
   794
  let
neuper@42432
   795
    val ((pt, _), _) = get_calc cI
neuper@42436
   796
		val pos = get_pos cI 1
neuper@42433
   797
    val fillforms = find_fillpatterns (pt, pos) errpatID 
neuper@42432
   798
  in
neuper@42433
   799
    case filter ((curry op = fillpatID) o 
neuper@42433
   800
        (#1: (fillpatID * term * thm * (subs option) -> fillpatID))) fillforms of
neuper@42434
   801
      (_, fillform, thm, sube_opt) :: _ =>
neuper@42432
   802
        let
neuper@42434
   803
          val (pt, pos') = generate_inconsistent_rew (sube_opt, thm'_of_thm thm)
neuper@42437
   804
            fillform (get_loc pt pos) pos pt
neuper@42432
   805
        in
neuper@42432
   806
          (upd_calc cI ((pt, pos'), []); (*upd_ipos cI 1 pos';*)
neuper@42432
   807
           autocalculateOK2xml cI pos pos' pos')
neuper@42432
   808
        end
neuper@42432
   809
    | _ => autocalculateERROR2xml cI "no fillpattern found"    
neuper@42432
   810
  end;    
neuper@37906
   811
neuper@42437
   812
(* input a formula which exactly fills the gaps in a "fillformula"
neuper@42437
   813
   presented to the learner immediately before by "requestFillformula (errpatID, fillpatID)":
neuper@42437
   814
   errpatID: lhs of the respective thm = lhs of fillformula with fillpatID.
neuper@42437
   815
   The respective thm is stored in the ctree. *)
neuper@42437
   816
fun inputFillFormula cI ifo =
neuper@42437
   817
  let
neuper@42437
   818
    val ((pt, _), _) = get_calc cI
neuper@42437
   819
    val pos = get_pos cI 1;
neuper@42437
   820
  in
neuper@42437
   821
    case is_exactly_equal (pt, pos) ifo of
neuper@42437
   822
      ("ok", tac) =>
neuper@42437
   823
        let
neuper@42437
   824
        in (* cp from applyTactic *)
neuper@42437
   825
          case locatetac tac (pt, pos) of
neuper@42437
   826
            ("ok", (_, c, ptp as (_,p'))) =>
neuper@42437
   827
              (upd_calc cI (ptp, []);
neuper@42437
   828
               upd_ipos cI 1 p';
neuper@42437
   829
               autocalculateOK2xml cI pos (if null c then p' else last_elem c) p')
neuper@42437
   830
          | ("unsafe-ok", (_, c, ptp as (_,p'))) =>
neuper@42437
   831
              (upd_calc cI (ptp, []);
neuper@42437
   832
               upd_ipos cI 1 p';
neuper@42437
   833
               autocalculateOK2xml cI pos (if null c then p' else last_elem c) p')
neuper@42437
   834
          | ("end-of-calculation", (_, c, ptp as (_,p'))) =>
neuper@42437
   835
              (upd_calc cI (ptp, []);
neuper@42437
   836
               upd_ipos cI 1 p';
neuper@42437
   837
               autocalculateOK2xml cI pos (if null c then p' else last_elem c) p')
neuper@42437
   838
          | (str,_) => autocalculateERROR2xml cI "failure"
neuper@42437
   839
        end
neuper@42437
   840
    | (msg, _) => message2xml cI msg
neuper@42437
   841
 end
neuper@42437
   842
neuper@37906
   843
(*------------------------------------------------------------------*)
neuper@37906
   844
end
neuper@37906
   845
open interface;
neuper@37906
   846
(*------------------------------------------------------------------*)