test/Tools/isac/Interpret/mathengine.sml
author Walther Neuper <neuper@ist.tugraz.at>
Mon, 18 Jul 2011 16:42:26 +0200
branchdecompose-isar
changeset 42105 64f12a53d644
parent 42104 6879bed0ff4d
child 42109 cd33f1f80c8a
permissions -rw-r--r--
finished: make autocalc..CompleteCalc run with x+1=2
neuper@37906
     1
(* test for sml/ME/mathengine.sml
neuper@37906
     2
   authors: Walther Neuper 2000, 2006
neuper@37906
     3
   (c) due to copyright terms
neuper@37906
     4
*)
neuper@38065
     5
"--------------------------------------------------------";
neuper@38065
     6
"table of contents --------------------------------------";
neuper@38065
     7
"--------------------------------------------------------";
neuper@41940
     8
"----------- change to parse ctxt -----------------------";
neuper@38065
     9
"----------- debugging setContext..pbl_ -----------------";
neuper@38065
    10
"----------- tryrefine ----------------------------------";
neuper@41982
    11
"----------- fun step: Apply_Method without init_form ---";
neuper@38065
    12
"----------- fun step -----------------------------------";
neuper@38065
    13
"----------- fun autocalc -------------------------------";
neuper@38065
    14
"----------- fun autoCalculate --------------------------";
neuper@42067
    15
"----------- fun autoCalculate..CompleteCalc ------------";
neuper@38065
    16
"--------------------------------------------------------";
neuper@38065
    17
"--------------------------------------------------------";
neuper@38065
    18
"--------------------------------------------------------";
neuper@37906
    19
neuper@41940
    20
"----------- change to parse ctxt -----------------------";
neuper@41940
    21
"----------- change to parse ctxt -----------------------";
neuper@41940
    22
"----------- change to parse ctxt -----------------------";
neuper@41940
    23
"===== start calculation: from problem description (fmz) to origin";
neuper@41940
    24
val fmz = ["realTestGiven (((1+2)*4/3)^^^2)","realTestFind s"];
neuper@41940
    25
val (thyID, pblID, metID) =
neuper@41940
    26
  ("Test", ["calculate", "test"], ["Test", "test_calculate"]);
neuper@41940
    27
val (p,_,_,nxt,_,pt) = CalcTreeTEST [(fmz, (thyID, pblID, metID))];
neuper@41940
    28
"----- ";
neuper@41940
    29
(* call sequence: CalcTreeTEST 
neuper@41940
    30
                > nxt_specify_init_calc 
neuper@41940
    31
                > prep_ori
neuper@41940
    32
*)
neuper@41940
    33
val (thy, pbt) = (Thy_Info.get_theory thyID, (#ppc o get_pbt) pblID);
neuper@41940
    34
"----- in  prep_ori";
neuper@41940
    35
val ctxt = ProofContext.init_global thy;
neuper@41940
    36
bonzai@41952
    37
val ctopts = map (parseNEW ctxt) fmz;
bonzai@41952
    38
val dts = map (split_dts o the) ctopts;
neuper@41940
    39
(*split_dts:
neuper@41940
    40
(term * term list) list
neuper@41940
    41
        formulas: e.g. ((1+2)*4/3)^^^2
neuper@41940
    42
 description: e.g. realTestGiven
neuper@41940
    43
*)
neuper@41940
    44
 prep_ori;
neuper@41940
    45
(* FROM
neuper@41940
    46
val it = fn:
neuper@41940
    47
   string list -> theory -> (string * (term * 'a)) list -> ori list
neuper@41940
    48
TO
neuper@41940
    49
val it = fn:
neuper@41940
    50
   string list -> theory -> (string * (term * 'a)) list -> (ori list * ctxt)
neuper@41940
    51
AND
neuper@41940
    52
FROM val oris = prep_ori...
neuper@41940
    53
TO   val (oris, _) = prep_ori...
neuper@41940
    54
*)
neuper@41940
    55
"----- insert ctxt in ptree";
neuper@41940
    56
(* datatype ppobj
neuper@41940
    57
FROM loc   : istate option * istate option,
neuper@41940
    58
TO   loc   : (istate * ctxt) option * (istate * ctxt) option,
neuper@41940
    59
e.g.
neuper@41940
    60
FROM val pt = Nd (PblObj
neuper@41940
    61
       {.., loc = (SOME (ScrState ([], [], NONE, Const ("empty", "'a"), Sundef, false)),
neuper@41940
    62
          NONE),
neuper@41940
    63
TO   val pt = Nd (PblObj
neuper@41940
    64
       {.., loc = 
neuper@41940
    65
        ((SOME (ScrState ([], [], NONE, Const ("empty", "'a"), Sundef, false)), ctxt),
neuper@41940
    66
          NONE),
neuper@41940
    67
*)
neuper@41940
    68
neuper@41940
    69
"===== interactive specification: from origin to specification (probl)";
neuper@41940
    70
val (p,_,_,nxt,_,pt) = me nxt p [1] pt; 
neuper@41940
    71
  (*nxt =("Add_Given", Model_Problem)*)
neuper@41940
    72
val (p,_,_,nxt,_,pt) = me nxt p [1] pt;
neuper@41940
    73
  (*nxt = ("Add_Find",Add_Find "realTestFind s") : string * tac*)
neuper@41940
    74
"----- ";
neuper@41940
    75
(* call sequence: me Model_Problem 
neuper@41940
    76
                > me ("Add_Given", Add_Given "realTestGiven (((1 + 2) * 4 / 3) ^^^ 2)")
neuper@41940
    77
                > locatetac tac
neuper@41940
    78
                > loc_specify_
neuper@41940
    79
                > specify          GET ctxt (stored in ctree)
neuper@41940
    80
                > specify_additem
neuper@41940
    81
                > appl_add
neuper@41940
    82
neuper@41940
    83
*)
neuper@41940
    84
"----- in appl_add";
neuper@41940
    85
(* FROM appl_add thy
neuper@41940
    86
   TO   appl_add ctxt
neuper@41940
    87
   FROM parse thy str
neuper@41940
    88
   TO   parseNEW ctxt str
neuper@41940
    89
*)
neuper@41940
    90
val (p,_,_,nxt,_,pt) = me nxt p [1] pt; 
neuper@41940
    91
  (*nxt = ("Specify_Theory",Specify_Theory "Test") : string * tac*)
neuper@41940
    92
val (p,_,_,nxt,_,pt) = me nxt p [1] pt; 
neuper@41940
    93
  (*nxt = ("Specify_Problem",Specify_Problem ["calculate","test"])*)
neuper@41940
    94
neuper@41940
    95
"===== end specify: from specification (probl) to guard (method)";
neuper@41940
    96
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41940
    97
  (*nxt = ("Specify_Method",Specify_Method ("Test","test_calculate"))*)
neuper@41940
    98
neuper@41940
    99
"===== start interpretation: from guard to environment";
neuper@41940
   100
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41940
   101
  (*nxt = ("Apply_Method",Apply_Method ("Test","test_calculate"))*)
neuper@41940
   102
"----- ";
neuper@41940
   103
(* call sequence: me ("Apply_Method",...
neuper@41940
   104
                > locatetac
neuper@41940
   105
                > loc_solve_
neuper@41940
   106
                > solve ("Apply_Method",...
neuper@41940
   107
*)
neuper@41940
   108
val ((_,tac), ptp) = (nxt, (pt, p));
neuper@41940
   109
locatetac tac (pt,p);
neuper@41940
   110
  val (mI, m) = mk_tac'_ tac;
neuper@41940
   111
  val Appl m = applicable_in p pt m;
neuper@41940
   112
  member op = specsteps mI;
neuper@41940
   113
  loc_solve_ (mI,m) ptp;
neuper@41940
   114
    val (m, (pt, pos)) = ((mI,m), ptp);
neuper@41940
   115
    solve m (pt, pos);
bonzai@41949
   116
      val ((_, m as Apply_Method' (mI, _, _, _)), (pt, (pos as (p,_)))) = 
neuper@41940
   117
        (m, (pt, pos));
neuper@41940
   118
      val {srls,...} = get_met mI;
neuper@41940
   119
      val PblObj{meth=itms,...} = get_obj I pt p;
neuper@41940
   120
      val thy' = get_obj g_domID pt p;
neuper@41940
   121
      val thy = assoc_thy thy';
bonzai@41949
   122
      val (is as ScrState (env,_,_,_,_,_), ctxt, sc) = init_scrstate thy itms mI;
neuper@41940
   123
neuper@41940
   124
"----- go on in the calculation";
neuper@41940
   125
val (p,_,f,nxt,_,pt) = me nxt pos [1] pt;
neuper@41940
   126
  (*nxt = ("Calculate",Calculate "PLUS")*)
neuper@41940
   127
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41940
   128
  (*nxt = ("Calculate",Calculate "TIMES")*)
neuper@41940
   129
neuper@41940
   130
"===== input a formula to be derived from previous istate";
neuper@41940
   131
"----- appendFormula TODO: first repair error";
neuper@41940
   132
  val cs = ((pt,p),[]);
neuper@41940
   133
  val ("ok", cs' as (_,_,(pt,p))) = step p cs;
neuper@41943
   134
  val ifo = (* encode "4^^^2" \<longrightarrow>*) "4^2";
neuper@41940
   135
(*
neuper@41943
   136
  val ("no derivation found", (_,_,(pt, p))) = inform cs' ((*encode*) ifo);
neuper@41940
   137
  here ^^^^^^^^^^^^^^^^^^^^^ should be "ok"
neuper@41940
   138
*)
neuper@41940
   139
neuper@41940
   140
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41940
   141
(*nxt = ("Calculate",Calculate "DIVIDE")*)
neuper@41940
   142
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41940
   143
(*nxt = ("Calculate",Calculate "POWER")*)
neuper@41940
   144
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41940
   145
(*nxt = ("Check_Postcond",Check_Postcond ["calculate","test"])*)
neuper@41940
   146
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41940
   147
(*nxt = ("End_Proof'",End_Proof')*)
neuper@41940
   148
if f = Form' (FormKF (~1,EdUndef,0,Nundef,"16")) then ()
neuper@41940
   149
else error "calculate.sml: script test_calculate changed behaviour";
neuper@41940
   150
neuper@41940
   151
"===== tactic Subproblem: from environment to origin";
neuper@41940
   152
"----- TODO";
neuper@41940
   153
neuper@38065
   154
(*=== inhibit exn ?=============================================================
neuper@37906
   155
neuper@38065
   156
"----------- debugging setContext..pbl_ -----------------";
neuper@38065
   157
"----------- debugging setContext..pbl_ -----------------";
neuper@38065
   158
"----------- debugging setContext..pbl_ -----------------";
neuper@37906
   159
states:=[];
neuper@41970
   160
CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"], 
neuper@41970
   161
  ("Test", ["sqroot-test","univariate","equation","test"],
neuper@37906
   162
   ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
   163
Iterator 1;
neuper@37906
   164
moveActiveRoot 1; modelProblem 1;
neuper@37906
   165
neuper@37906
   166
val pos as (p,_) = ([],Pbl);
neuper@37906
   167
val guh = "pbl_equ_univ";
neuper@37906
   168
checkContext 1 pos guh;
neuper@37906
   169
val ((pt,_),_) = get_calc 1;
neuper@37906
   170
val pp = par_pblobj pt p;
neuper@37906
   171
val keID = guh2kestoreID guh;
neuper@37906
   172
case context_pbl keID pt pp of (true,["univariate", "equation"],_,_,_)=>()
neuper@38031
   173
| _ => error "mathengine.sml: context_pbl .. pbl_equ_univ checked";
neuper@37906
   174
neuper@37906
   175
case get_obj g_spec pt p of (_, ["e_pblID"], _) => ()
neuper@38031
   176
| _ => error "mathengine.sml: context_pbl .. pbl still empty";
neuper@37906
   177
setContext 1 pos guh;
neuper@37906
   178
val ((pt,_),_) = get_calc 1;
neuper@37906
   179
case get_obj g_spec pt p of (_, ["univariate", "equation"], _) => ()
neuper@38031
   180
| _ => error "mathengine.sml: context_pbl .. pbl set";
neuper@37906
   181
neuper@37906
   182
neuper@37906
   183
setContext 1 pos "met_eq_lin";
neuper@37906
   184
val ((pt,_),_) = get_calc 1;
neuper@37906
   185
case get_obj g_spec pt p of (_,  _, ["LinEq", "solve_lineq_equation"]) => ()
neuper@38031
   186
| _ => error "mathengine.sml: context_pbl .. pbl set";
neuper@37906
   187
neuper@37906
   188
neuper@38065
   189
"----------- tryrefine ----------------------------------";
neuper@38065
   190
"----------- tryrefine ----------------------------------";
neuper@38065
   191
"----------- tryrefine ----------------------------------";
neuper@37906
   192
states:=[];
neuper@37906
   193
CalcTree [(["equality (x/(x^2 - 6*x+9) - 1/(x^2 - 3*x) =1/x)", 
neuper@37906
   194
	    "solveFor x", "solutions L"],
neuper@38058
   195
	   ("RatEq",["univariate","equation"],["no_met"]))];
neuper@37906
   196
Iterator 1;
neuper@37906
   197
moveActiveRoot 1; autoCalculate 1 CompleteCalc;
neuper@37906
   198
neuper@37906
   199
refineProblem 1 ([1],Res) "pbl_equ_univ" 
neuper@37906
   200
(*gives "pbl_equ_univ_rat" correct*);
neuper@37906
   201
neuper@37906
   202
refineProblem 1 ([1],Res) (pblID2guh ["linear","univariate","equation"])
neuper@38065
   203
(*gives "pbl_equ_univ_lin" incorrect*);
neuper@38065
   204
neuper@38065
   205
neuper@41982
   206
"----------- fun step: Apply_Method without init_form ---";
neuper@41982
   207
"----------- fun step: Apply_Method without init_form ---";
neuper@41982
   208
"----------- fun step: Apply_Method without init_form ---";
neuper@41982
   209
val fmz = ["equality (x+1=(2::real))", "solveFor x","solutions L"];
neuper@41982
   210
val (dI',pI',mI') =
neuper@41982
   211
  ("Test", ["sqroot-test","univariate","equation","test"],
neuper@41982
   212
   ["Test","squ-equ-test-subpbl1"]);
neuper@41982
   213
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@41982
   214
"~~~~~ fun me, args:"; val (_,tac) = nxt;
neuper@41982
   215
val ("ok", (_, _, (pt, p))) = locatetac tac (pt,p);
neuper@41982
   216
"~~~~~ fun step, args:"; val (ip as (_,p_), ptp as (pt,p), tacis) = (p, (pt, e_pos'), []);
neuper@41982
   217
val pIopt = get_pblID (pt,ip);
neuper@41982
   218
ip = ([],Res) (*false*);
neuper@41982
   219
val SOME pI = pIopt;
neuper@41982
   220
member op = [Pbl,Met] p_ andalso is_none (get_obj g_env pt (fst p))
neuper@41982
   221
			                          (*^^^^^^^^: Apply_Method without init_form*)
neuper@42067
   222
===== inhibit exn ?===========================================================*)
neuper@38065
   223
neuper@38065
   224
"----------- fun step -----------------------------------";
neuper@38065
   225
"----------- fun step -----------------------------------";
neuper@38065
   226
"----------- fun step -----------------------------------";
neuper@38065
   227
val p = e_pos'; val c = []; 
neuper@38065
   228
val (p,_,f,nxt,_,pt) = 
neuper@38065
   229
    CalcTreeTEST 
neuper@38065
   230
        [(["functionTerm (x^^^2 + 1)", "integrateBy x", "antiDerivative FF"], 
neuper@38065
   231
          ("Integrate", ["integrate","function"], ["diff","integration"]))];
neuper@38065
   232
"----- step 1: returns tac = Model_Problem ---";
neuper@38065
   233
val (str, ([(tac, _, _)], _, (pt, p))) = step p ((pt, e_pos'), []);
neuper@38065
   234
"----- step 2: returns tac =  ---";
neuper@38065
   235
val (str, ([(tac, _, _)], _, (pt, p))) = step p ((pt, e_pos'), []);
neuper@38065
   236
"----- step 3: returns tac =  ---";
neuper@38065
   237
val (str, ([(tac, _, _)], _, (pt, p))) = step p ((pt, e_pos'), []);
neuper@38065
   238
"----- step 4: returns tac =  ---";
neuper@38065
   239
val (str, ([(tac, _, _)], _, (pt, p))) = step p ((pt, e_pos'), []);
neuper@38065
   240
"----- step 5: returns tac =  ---";
neuper@38065
   241
neuper@38065
   242
(*========== inhibit exn =======================================================
neuper@38066
   243
2002 stops here as well: TODO review actual arguments:
neuper@38065
   244
val (str, ([(tac, _, _)], _, (pt, p))) = step p ((pt, e_pos'), []);
neuper@38065
   245
"----- step 6: returns tac =  ---";
neuper@38065
   246
val (str, ([(tac, _, _)], _, (pt, p))) = step p ((pt, e_pos'), []);
neuper@38065
   247
"----- step 7: returns tac =  ---";
neuper@38065
   248
val (str, ([(tac, _, _)], _, (pt, p))) = step p ((pt, e_pos'), []);
neuper@38065
   249
"----- step 8: returns tac =  ---";
neuper@38065
   250
val (str, ([(tac, _, _)], _, (pt, p))) = step p ((pt, e_pos'), []);
neuper@38065
   251
============ inhibit exn =====================================================*)
neuper@38065
   252
neuper@38065
   253
neuper@38065
   254
"----------- fun autocalc -------------------------------";
neuper@38065
   255
"----------- fun autocalc -------------------------------";
neuper@38065
   256
"----------- fun autocalc -------------------------------";
neuper@38065
   257
val p = e_pos'; val c = []; 
neuper@38065
   258
val (p,_,f,nxt,_,pt) = 
neuper@38065
   259
    CalcTreeTEST 
neuper@38065
   260
        [(["functionTerm (x^^^2 + 1)", "integrateBy x", "antiDerivative FF"], 
neuper@38065
   261
          ("Integrate",["integrate","function"], ["diff","integration"]))];
neuper@38066
   262
(*-----since Model_Problem + complete_mod_ in case cas of SOME-----*
neuper@38066
   263
modeling is skipped FIXME 
neuper@38066
   264
 *-----since Model_Problem + complete_mod_ in case cas of SOME-----*)
neuper@38065
   265
tracing "----- step 1 ---";
neuper@38065
   266
val (str, cut, (pt, p)) = autocalc [] p ((pt, e_pos'),[]) (Step 1); show_pt pt;
neuper@38065
   267
tracing "----- step 2 ---";
neuper@38065
   268
val (str, cut, (pt, p)) = autocalc [] p ((pt, e_pos'),[]) (Step 1); show_pt pt;
neuper@38065
   269
tracing "----- step 3 ---";
neuper@38065
   270
val (str, cut, (pt, p)) = autocalc [] p ((pt, e_pos'),[]) (Step 1); show_pt pt;
neuper@38065
   271
tracing "----- step 4 ---";
neuper@38065
   272
val (str, cut, (pt, p)) = autocalc [] p ((pt, e_pos'),[]) (Step 1); show_pt pt;
neuper@38065
   273
tracing "----- step 5 ---";
neuper@38065
   274
val (str, cut, (pt, p)) = autocalc [] p ((pt, e_pos'),[]) (Step 1); show_pt pt;
neuper@38065
   275
tracing "----- step 6 ---";
neuper@38065
   276
val (str, cut, (pt, p)) = autocalc [] p ((pt, e_pos'),[]) (Step 1); show_pt pt;
neuper@38065
   277
tracing "----- step 7 ---";
neuper@38065
   278
val (str, cut, (pt, p)) = autocalc [] p ((pt, e_pos'),[]) (Step 1); show_pt pt;
neuper@38065
   279
tracing "----- step 8 ---";
neuper@38065
   280
val (str, cut, (pt, p)) = autocalc [] p ((pt, e_pos'),[]) (Step 1); show_pt pt;
neuper@42067
   281
(*========== inhibit exn 110628 ================================================
neuper@42067
   282
WN110628: Integration does not work, see Knowledge/integrate.sml
neuper@42067
   283
neuper@41929
   284
if str = "end-of-calculation" andalso 
neuper@41929
   285
   term2str (get_obj g_res pt (fst p)) = "c + x + 1 / 3 * x ^^^ 3" then ()
neuper@38065
   286
else error "mathengine.sml -- fun autocalc -- end";
neuper@42067
   287
============ inhibit exn 110628 ==============================================*)
neuper@38065
   288
neuper@38065
   289
neuper@38065
   290
"----------- fun autoCalculate -----------------------------------";
neuper@38065
   291
"----------- fun autoCalculate -----------------------------------";
neuper@38065
   292
"----------- fun autoCalculate -----------------------------------";
neuper@38065
   293
states := [];
neuper@38065
   294
CalcTree (*ATTENTION: encode_fmz ... unlike CalcTreeTEST*)
neuper@38065
   295
    [(["functionTerm (x^2 + 1)", "integrateBy x", "antiDerivative FF"],
neuper@38065
   296
      ("Integrate", ["integrate", "function"], ["diff", "integration"]))];
neuper@38065
   297
Iterator 1;
neuper@38065
   298
moveActiveRoot 1;
neuper@38066
   299
(*-----since Model_Problem + complete_mod_ in case cas of SOME-----*
neuper@38066
   300
modeling is skipped FIXME 
neuper@38066
   301
see test/../interface -- solve_linear as rootpbl FE -- for OTHER expl:
neuper@38066
   302
 setNextTactic 1 (Add_Given "equality (1 + -1 * 2 + x = 0)");
neuper@38066
   303
 autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1); (*equality added*);
neuper@38066
   304
neuper@38066
   305
 fetchProposedTactic 1;
neuper@38066
   306
 setNextTactic 1 (Add_Given "solveFor x");
neuper@38066
   307
 autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
neuper@38066
   308
neuper@38066
   309
 fetchProposedTactic 1;
neuper@38066
   310
 setNextTactic 1 (Add_Find "solutions L");
neuper@38066
   311
 autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
neuper@38066
   312
neuper@38066
   313
 fetchProposedTactic 1;
neuper@38066
   314
 setNextTactic 1 (Specify_Theory "Test");
neuper@38066
   315
 autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
neuper@38066
   316
*-----since Model_Problem + complete_mod_ in case cas of SOME-----*)
neuper@38065
   317
autoCalculate 1 (Step 1); 
neuper@38065
   318
"----- step 1 ---";
neuper@38065
   319
autoCalculate 1 (Step 1);
neuper@38065
   320
"----- step 2 ---";
neuper@38065
   321
autoCalculate 1 (Step 1);
neuper@38065
   322
"----- step 3 ---";
neuper@38065
   323
autoCalculate 1 (Step 1);
neuper@38065
   324
"----- step 4 ---";
neuper@38065
   325
autoCalculate 1 (Step 1);
neuper@38065
   326
"----- step 5 ---";
neuper@38065
   327
autoCalculate 1 (Step 1);
neuper@38065
   328
"----- step 6 ---";
neuper@38065
   329
autoCalculate 1 (Step 1);
neuper@38065
   330
"----- step 7 ---";
neuper@38065
   331
autoCalculate 1 (Step 1);
neuper@38065
   332
"----- step 8 ---";
neuper@38065
   333
autoCalculate 1 (Step 1);
neuper@38065
   334
val (ptp as (_, p), _) = get_calc 1;
neuper@38065
   335
val (Form t,_,_) = pt_extract ptp;
neuper@41929
   336
(*========== inhibit exn 110310 ================================================
neuper@38065
   337
if term2str t = "c + x + 1 / 3 * x ^^^ 3" andalso p = ([], Res) then ()
neuper@38065
   338
else error "mathengine.sml -- fun autoCalculate -- end";
neuper@42067
   339
============ inhibit exn 110310 ==============================================*)
neuper@38065
   340
neuper@42067
   341
"----------- fun autoCalculate..CompleteCalc ------------";
neuper@42067
   342
"----------- fun autoCalculate..CompleteCalc ------------";
neuper@42067
   343
"----------- fun autoCalculate..CompleteCalc ------------";
neuper@42067
   344
 states:=[];
neuper@42067
   345
 CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"], 
neuper@42067
   346
   ("Test", ["sqroot-test","univariate","equation","test"],
neuper@42067
   347
    ["Test","squ-equ-test-subpbl1"]))];
neuper@42067
   348
 Iterator 1;
neuper@42103
   349
 moveActiveRoot 1; 
neuper@42103
   350
(*autoCalculate 1 CompleteCalc; (*WAS <SYSERROR>..<ERROR> error in kernel </ERROR>*)*)
neuper@42103
   351
"~~~~~ fun autoCalculate, args:"; val (cI, auto) = (1, CompleteCalc);
neuper@42103
   352
val pold = get_pos cI 1;
neuper@42103
   353
(*autocalc [] pold (get_calc cI) auto;  (*WAS Type unification failed
neuper@42103
   354
  Type error in application: incompatible operand type
neuper@42103
   355
  Operator:  solveFor :: real \<Rightarrow> una
neuper@42103
   356
  Operand:   x :: 'a *)*)
neuper@42103
   357
"~~~~~ fun autocalc, args:"; val (c, (pos as (_,p_)), ((pt,_), _), auto) 
neuper@42103
   358
                               = ([] : pos' list, pold, (get_calc cI), auto);
neuper@42103
   359
autoord auto > 3 andalso just_created (pt, pos); (*true*)
neuper@42103
   360
val ptp = all_modspec (pt, pos);
neuper@42103
   361
"TODO all_modspec: preconds for rootpbl";
neuper@42103
   362
(*all_solve auto c ptp; (*WAS Type unification failed...*)*)
neuper@42103
   363
"~~~~~ and all_solve, args:"; val (auto, c, (ptp as (pt, pos as (p,_)))) =
neuper@42103
   364
                                                                  (auto, c, ptp);
neuper@42103
   365
    val (_,_,mI) = get_obj g_spec pt p
neuper@42103
   366
    val ctxt = get_ctxt pt pos
neuper@42103
   367
    val (ttt, c', ptp) = nxt_solv (Apply_Method' (mI, NONE, e_istate, ctxt)) (e_istate, ctxt) ptp;
neuper@42103
   368
(* complete_solve auto (c @ c') ptp; (*WAS Type unification failed...*) pos = ([], Met)*)
neuper@42103
   369
"~~~~~ fun complete_solve, args:"; val (auto, c, (ptp as (_, p as (_,p_)))) =
neuper@42103
   370
                                                           (auto, (c @ c'), ptp);
neuper@42103
   371
p = ([], Res) (*false p = ([1], Frm)*);
neuper@42103
   372
member op = [Pbl,Met] p_ (*false*);
neuper@42103
   373
val (ttt, c', ptp') = nxt_solve_ ptp; (*ttt = Rewrite_Set "norm_equation"*)
neuper@42103
   374
(* complete_solve auto (c @ c') ptp'; (*WAS Type unification failed...*) pos = ([], Met)*)
neuper@42103
   375
"~~~~~ fun complete_solve, args:"; val (auto, c, (ptp as (_, p as (_,p_)))) =
neuper@42103
   376
                                                           (auto, (c @ c'), ptp');
neuper@42103
   377
p = ([], Res) (*false p = ([1], Res)*);
neuper@42103
   378
member op = [Pbl,Met] p_ (*false*);
neuper@42103
   379
val (ttt, c', ptp') = nxt_solve_ ptp; (*ttt = Rewrite_Set "Test_simplify"*)
neuper@42103
   380
(* complete_solve auto (c @ c') ptp'; (*WAS Type unification failed...*) pos = ([], Met)*)
neuper@42103
   381
"~~~~~ fun complete_solve, args:"; val (auto, c, (ptp as (_, p as (_,p_)))) =
neuper@42103
   382
                                                           (auto, (c @ c'), ptp');
neuper@42103
   383
p = ([], Res) (*false p = ([2], Res)*);
neuper@42103
   384
member op = [Pbl,Met] p_ (*false*);
neuper@42103
   385
val ((Subproblem _, tac_, (_, is))::_, c', ptp') = nxt_solve_ ptp;
neuper@42103
   386
autoord auto < 5 (*false*);
neuper@42103
   387
(* val ptp = all_modspec ptp' (*WAS Type unification failed...*)*)
neuper@42103
   388
"~~~~~ fun all_modspec, args:"; val (pt, pos as (p,_)) = (ptp');
neuper@42103
   389
    val (PblObj {fmz = (fmz_, _), origin = (pors, spec as (dI,pI,mI), hdl), ...}) = get_obj I pt p;
neuper@42103
   390
    val thy = assoc_thy dI;
neuper@42103
   391
	    val {ppc, ...} = get_met mI;
neuper@42103
   392
(*  val (mors, ctxt) = prep_ori fmz_ thy ppc; WAS Type unification failed because
neuper@42103
   393
val ctxt' = dI |> Thy_Info.get_theory |> ProofContext.init_global;
neuper@42103
   394
(parseNEW ctxt' "x" |> the |> type_of) = TFree ("'a",[]); 
neuper@42103
   395
                                               ^^^^^ *)
neuper@42103
   396
(*vvv from:  | assod pt _ (Subproblem'...*)
neuper@42103
   397
    val (fmz_, vals) = oris2fmz_vals pors;
neuper@42103
   398
(**)
neuper@42103
   399
    val ctxt = dI |> Thy_Info.get_theory |> ProofContext.init_global 
neuper@42103
   400
      |> declare_constraints' vals
neuper@42103
   401
(**)
neuper@42103
   402
(*^^^ from:  | assod pt _ (Subproblem'...*)
neuper@42103
   403
val [(1, [1], "#Given", dsc_eq, [equality]),
neuper@42103
   404
     (2, [1], "#Given", dsc_solvefor, [xxx]),
neuper@42103
   405
     (3, [1], "#Find", dsc_solutions, [x_i])] = pors;
neuper@42103
   406
if term2str xxx = "x" andalso type_of xxx = HOLogic.realT then () 
neuper@42103
   407
else error "autoCalculate..CompleteCalc: SubProblem broken 1";
neuper@42103
   408
    val pt = update_pblppc pt p (map (ori2Coritm ppc) pors);
neuper@42103
   409
	    val pt = update_metppc pt p (map (ori2Coritm ppc) pors);
neuper@42103
   410
	    val pt = update_spec pt p (dI,pI,mI);
neuper@42103
   411
    val pt = update_ctxt pt p ctxt;
neuper@42103
   412
"~~~~~ return to complete_solve, args:"; val (ptp) = (pt, (p,Met));
neuper@42103
   413
val (msg, c, (pt, p)) = complete_solve auto (c @ c') ptp;
neuper@42103
   414
if msg = "end-of-calculation" andalso c = [] andalso p = ([], Res) then ()
neuper@42103
   415
else error "autoCalculate..CompleteCalc: final result";
neuper@42103
   416
if terms2strs (get_assumptions_ pt p) = 
neuper@42105
   417
  ["matches (?a = ?b) (-1 + x = 0)", (*precond of submet*) 
neuper@42104
   418
   "x = 1",                          (*result of subpbl and rootpbl*)
neuper@42104
   419
   "precond_rootmet x"]              (*precond of rootmet*)
neuper@42103
   420
then () else error "autoCalculate..CompleteCalc: ctxt at final result";
neuper@42067
   421