src/Tools/isac/Frontend/interface.sml
author Walther Neuper <neuper@ist.tugraz.at>
Sun, 10 Oct 2010 14:15:43 +0200
branchisac-update-Isa09-2
changeset 38056 98ebf8c25a28
parent 38050 4c52ad406c20
child 38058 ad0485155c0e
permissions -rw-r--r--
update finished for test/../integrate.sml

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